Excel VBA For Next ciklus flag probléma
2021-05-27T15:07:24+02:00
2021-05-28T10:14:17+02:00
2022-08-12T02:55:30+02:00
amatore
Sziasztok,

Futtatok egy ciklust, aminek az lenne a feladata, hogy szinezze pirosra azokat a sorokat (A-C oszlop), amelyikben az E oszlopban nem "partner_osszesen" és a fölötte levő sorokban nincs olyan sor, amiben az E oszlopban "partner_osszesen" van és az A és C oszlopban szereplő értékek megegyeznek (és ezeknél a soroknál is csak az első ilyen sort).
Csatoltam hozzá az Excel fájlt is.
Jelenleg a ciklus csak akkor szinezi a sort, ha egyik feltétel sem teljesül, de ha már talál a fölötte lévő sorokban azonos A oszlop értéket vagy azonos C oszlop értéket vagy talál az E oszlopban "partner_osszesen"-t, akkor már nem szinez. Viszont a 3 feltételt együttesen kellene néznie.
A D oszlopban pirossal szineztem azokat a sorokat, amit szineznie kellene a ciklusnak.
Ha valaki meg tudná mondani, hogy hol a hiba a makróban, az szuper lenne.
Nagyon köszönöm.

A makró így néz ki:


Sub check()
 
Application.ScreenUpdating = False
 
Dim lrow As Integer
    lrow = ActiveWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Dim j, l As Integer
Dim flag As Boolean
    flag = True
    
For j = 9 To lrow
    If ActiveWorkbook.Sheets("Sheet1").Range("E" & j).Value = "" Then
        For l = 9 To (j - 1)
            If ActiveWorkbook.Sheets("Sheet1").Range("E" & l).Value = "partner_osszesen" And _
            Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & l).Value, 12) = Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) And _
            Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & l).Value, 8) = Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) Then
                flag = False: Exit For
            End If
        Next l
            If flag Then
                If j = 9 Then
                    ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select
                    Selection.Interior.Color = 255
                Else
                    If Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & (j - 1)).Value, 12) And _
                    Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & (j - 1)).Value, 8) Then
                        ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select
                        Selection.Interior.Color = 255
                    End If
                End If
            End If
    End If
Next j
 
Application.ScreenUpdating = True
 
End Sub
Mutasd a teljes hozzászólást!
Csatolt állomány
Szia!
Nézd meg így a makrót:

Sub check() Application.ScreenUpdating = False Dim lrow As Integer lrow = ActiveWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row Dim j, l As Integer Dim flag As Boolean flag = True For j = 9 To lrow If ActiveWorkbook.Sheets("Sheet1").Range("E" & j).Value = "" Then For l = 9 To (j - 1) If ActiveWorkbook.Sheets("Sheet1").Range("E" & l).Value = "partner_osszesen" And _ Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & l).Value, 12) = Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) And _ Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & l).Value, 8) = Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) Then flag = False: Exit For End If Next l If flag Then If j = 9 Then ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select Selection.Interior.Color = 255: flag = False Else If Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & (j - 1)).Value, 12) And _ Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & (j - 1)).Value, 8) Then ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select Selection.Interior.Color = 255: flag = False End If End If Else If Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & (j - 1)).Value, 12) Or _ Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & (j - 1)).Value, 8) Then ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select Selection.Interior.Color = 255: flag = False End If End If End If Next j Application.ScreenUpdating = True End Sub
Üdv.
Mutasd a teljes hozzászólást!

  • Szia!
    Az a probléma, hogy a makró azt csinálja, amit beleírtál:
    Az első feltételnél vizsgálod, hogy az összesen sorhoz tartozó rendelés és 2. kód értéket megegyeznek-e az adott sorban található hasonló értékekkel. 
    A második vizsgálatnál viszont azt nézed meg, hogy ezek az értékek az előző sorban levő értékkel egyeznek-e.
    Az A15 cella értéke megegyezik az A14 cella értékével, de a C15 cella értéke nem egyezik a C14 cella értékével  -  így nem felel meg a színezés felételének!
    Hasonló a helyzet az A21 - A20 és C21 - C20 esetében (csak fordítva).
    Mivel itt nincs színezés, a flag sem állítódik át, ezért a további vizsgálatok nem végződnek el, tehát a flag változódat is át kellene állítani a vizsgálat érdekében.
    Vagyis ugyanazon rendelésszám másik ügyfélnél nem képezi színezés tárgyát.
    Üdv.
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • Szia,

    És akkor hogyan kellene módosítani a makrót?
    Köszönöm

    Üdv,
    Mutasd a teljes hozzászólást!
  • Szia!
    Kérdés, hogy a jelzett anomália (rendelésszám és 2.kód azonosság) "üzemszerűen" fennáll-e, számolni kell vele, vagy csak a teszt pontatlansága volt.
    Üdv.
    Mutasd a teljes hozzászólást!
  • Szia,
    Számolni kell vele.
    Üdv,
    Mutasd a teljes hozzászólást!
  • Szia!
    Nézd meg így a makrót:

    Sub check() Application.ScreenUpdating = False Dim lrow As Integer lrow = ActiveWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row Dim j, l As Integer Dim flag As Boolean flag = True For j = 9 To lrow If ActiveWorkbook.Sheets("Sheet1").Range("E" & j).Value = "" Then For l = 9 To (j - 1) If ActiveWorkbook.Sheets("Sheet1").Range("E" & l).Value = "partner_osszesen" And _ Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & l).Value, 12) = Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) And _ Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & l).Value, 8) = Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) Then flag = False: Exit For End If Next l If flag Then If j = 9 Then ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select Selection.Interior.Color = 255: flag = False Else If Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & (j - 1)).Value, 12) And _ Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & (j - 1)).Value, 8) Then ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select Selection.Interior.Color = 255: flag = False End If End If Else If Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & j).Value, 12) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("A" & (j - 1)).Value, 12) Or _ Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & j).Value, 8) <> Left(ActiveWorkbook.Sheets("Sheet1").Range("C" & (j - 1)).Value, 8) Then ActiveWorkbook.Sheets("Sheet1").Range("A" & j & ":C" & j).Select Selection.Interior.Color = 255: flag = False End If End If End If Next j Application.ScreenUpdating = True End Sub
    Üdv.
    Mutasd a teljes hozzászólást!
  • Szia
    Tökéletesen működik, köszönöm.
    Még ezt a flag-es témát tanulnom kell (minden más mellett is).
    Köszönöm még egyszer.
    Üdv,
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd