Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

makro do sprawdzenia wyniku formuły

Sławek_303 17 Sie 2010 05:39 1280 3
  • #1 17 Sie 2010 05:39
    Sławek_303
    Poziom 2  

    Witam!
    Potrzebuję pomocy. Zaczynam pisanie makr w VB i VBA. Chcę na początek napisać makro, które sprawdzi mi wynik formuły 'Porównaj' i w zależności od tego usunie 2 sąsiadujące komórki z tego wiersza z lewej strony lub sprawdzi komórkę poniżej i tak aż napotka komórkę bez formuły(pustą). Chcę to mieć w makrze by móc to rozbudowywać o kolejne procedury. Zamieszczam fragment arkusza z danymi.

    makro do sprawdzenia wyniku formuły

    0 3
  • #2 06 Wrz 2010 01:23
    Sławek_303
    Poziom 2  

    Udało mi się napisać taki kod, działa aż napotka komórkę z 'False' usuwa dwa pola w po lewej, kopiuje formułę w kolumnie z porównaniem i opuszcza pętlę. Jak sprawić by działało aż skończą sie dane w kolumnie(nie więcej niż 250 wierszy)?

    Code:
    Sub EX_LP()
    
    Dim x, y As String

    Range("G2").Select
        Selection.AutoFill Destination:=Range("G2:G250")
        For Each x In Worksheets("Dane").Range("G2:G250")
        If IsNumeric(ActiveCell) = True Then
        ActiveCell.Offset(1, 0).Select
            If ActiveCell.Value = False Then
            ActiveCell.Offset(0, -2).Select
            Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
            Selection.Delete Shift:=xlUp
            ActiveCell.Offset(-1, 2).Select
            Range("G2").Select
            Selection.AutoFill Destination:=Range("G2:G250")
            Range("G2").Select
            Exit For
            End If
        End If
      Next

    0
  • #3 06 Wrz 2010 08:43
    walek33
    Poziom 28  

    Na początek drobna sugestia. Ubieraj swój kod w znaczniki Code. Łatwiej się czyta. Wracając do problemu.

    Code:
    Sub EX_LP()
    

        Dim x, y As String

        Range("G2").Select
        Selection.AutoFill Destination:=Range("G2:G250")
        For Each x In ActiveSheet.Range("G2:G250")
            If IsNumeric(ActiveCell) = True Then
                ActiveCell.Offset(1, 0).Select
                If ActiveCell.Value = False Then
                    If (Not IsNumeric(ActiveCell.Offset(0, -2)) Or ActiveCell.Offset(0, -2).Value = "") Then Exit For
                    ActiveCell.Offset(0, -2).Select
                    Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
                    Selection.Delete Shift:=xlUp
                    ActiveCell.Offset(-1, 2).Select
                    Range("G2").Select
                    Selection.AutoFill Destination:=Range("G2:G250")
                    Range("G2").Select
    '                Exit For
                End If
            End If
        Next
    End Sub

    Twój kod po drobnej poprawce powinien działać prawidłowo. Exit For jest przeniesione troszkę wyżej.

    0
  • #4 12 Maj 2011 22:16
    Sławek_303
    Poziom 2  

    Po kilku próbach przerobiłem kod i wygląda teraz tak:
    Dim c, x, y, z As Integer

    x = 2
    y = 1
    Cells(x, 7).Select
    Range(Selection, Selection.End(xlDown)).Select
    z = Selection.Rows.Count


    For y = 1 To z
    Cells(x, 7).Select
    If ActiveCell.Value = "" Then
    GoTo c
    Else
    If Cells(x, 7) = True Then
    ActiveCell.Offset(1, 0).Select
    x = x + 1
    Else
    ActiveCell.Offset(0, -2).Select
    Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Offset(-1, 2).Select
    If ActiveCell.Value = "" Then
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=EXACT(RC[-6],RC[-2])"
    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(z - x, 0))
    Else
    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(z - x, 0))
    Cells(x, 7).Select
    y = x - 2
    z = z + 1

    End If
    End If
    End If
    Next

    '*****************************************************************************************
    'a
    'GoTo koniec



    c:
    Cells(R + 1, Kol_sklep).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=6, Criteria1:="="


    MsgBox ("Koniec programu!")

    End Sub

    0