VBA: Vergleichen mit mehreren Bedingungen

[Memo]

Hi Alexandra,

gut dann anderst gefragt. Ist der obige Code für eine Pivot basite Datentabelle programmiert worden?

Falls ja an welchen Stellen muss ich sie so abändern sodass Sie auf einer normalen Excel Datei funkt?

Falls nein, warum funkt Sie nicht (bei Datensätze bis Zeile 5000) ?

Ich mache mir ja gerne die Mühe die Pivot 1:1 zu kopieren und als Werte einfügen. Daher habe ich das Problem mit dem nicht funktionieren in Pivot´s ausm Weg geschafft.

Aber der obige Code funktioniert nicht einmal auf eine normale Makrolose Excel Datei.

Ich hoffe ich konnte mich verständlich genug ausdrücken und du weisst was ich meine, manchmal habe ich das Problem mit dem rüberbringen.

Grüße
Memo

[cysu11]

Hi Memo,


also bei mir funktioniert der Code in der Tabelle (keine Pivot) die du zur Verfügung gestellt hast, habe die Daten die du angegeben hast, bis zur Zeile 5000 runterkopiert! :)

LG
Alexandra

[Memo]

Hi,

also ich weiss net was bei mir verkehrt rum gelaufen ist bisher aber jetzt funktionert es.   :72: :72:


Kannst du mir vielleicht noch den code dazu verraten, sodass ich in Tabelle 2 die gleichen Überschriften habe wie in der Ursprungsdatei ?

Also komplette Zeile 1 und 2 aus Tabelle 1 exact in der Tabelle 2 darstellen. Sodass die Ergebnisse nach durchlaufen des makros unter die Überschriften aufgelistet werden.

Danke. :100:

Memo

[cysu11]

Hi Memo,

nur die Zeile ändern:

Code:

       .Resize(.Rows.Count - 1).Offset(-2, 0).Copy

LG
Alexandra

[Memo]

Super.

besten Dank Alexandra.

Schönen Tag noch.

VG
Memo

[Memo]

Hi Alexandra, Hallo Forum

ich würde gerne eine weitere Bedingung in die bereits funktionierenden Code einfügen bzw. diesen ein wenig abändern.

bisheriger Fall:

Betrachte Bereich M4 bis M5000.
Lese erstmal M4 aus. Wenn in M4 "IL2" steht dann springe zu Nebenspalte von IL2 (also zu CD), Wenn in M4 "IL3" steht dann springe zu Nebenspalte von IL3 (also zu CF), Wenn in M4 "IL4" steht dann springe zu Nebenspalte von IL4 (also zu CH), Wenn in M4 "IL5" steht dann springe zu Nebenspalte von IL5 (also zu CJ),  und vergleiche das Datum welches in dieser Zelle steht mit dem aktuellen Datum + 1 Monat.

Wenn das Datum in dieser Zelle das aktuelle Datum + 1 Monat übersteigt, dann nichts unternehmen. Wenn es nicht übersteigt, dann komplette Zeile gelb füllen.


Neuer Fall:

Betrachte Bereich M4 bis M5000.
Lese erstmal M4 aus. Wenn in M4 "IL2" steht dann springe zu Spalte "IL2 (Expected)" also zu CC. Wenn das Datum in dieser Zelle (also CC4) mit heute + kleiner als 1 Monat dann Gelb.
Wenn das Datum aus Zelle CC4 kleiner als heute + 1 Monat (also vor Heute) dann IL2+1 addieren, also bei "IL3 (Expected)" schauen.
Wenn das Datum aus IL3 (Expected) also Zelle CE4 auch in der Vergangenheit (also vor Heute), dann komplette Zeile Gelb füllen. Wenn in der Zukunft liegt also größer als heute +1 Monat, dann nichts tun.

zu Betrachten: IL2, IL3, IL4 und IL5.
zu Prüfen evtl. notwendig:
                     IL2+1 (IL3 Expected),
                     IL3+1 (IL4 Expected),
                     IL4+1 (IL5 Expected),
                     IL5+1 (IL6 Expected).


Bitte beachten:

kleiner als heute + 1 Monat ist nicht dasselbe wie heute + kleiner als 1 Monat.

Beispiel:
Kleiner als heute +1 Monat = vor 25.03.2019
Heute + kleiner als 1 Monat = 26.03.2019 bis 24.04.2019

Ich hoffe ich konnte alle Unstimmigkeiten ausm Weg räumen.

Das ist der funktionierender Code:

Sub Filtern()
Dim raZelle As Range, raZielzelle As Range
Dim daDatum As Date, loLetzte As Long
Dim loLetzteZ As Long
 
daDatum = DateSerial(Year(Date), Month(Date) + 1, Day(Date))

Application.ScreenUpdating = False

With Worksheets("Tabelle1")
    loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Each raZelle In .Range("M4:M" & loLetzte).SpecialCells(xlCellTypeConstants)
        Select Case raZelle.Value
            Case "IL2", "IL3", "IL4", "IL5"
                Set raZielzelle = .Range("2:2").Find(what:=raZelle.Value, _
                LookIn:=xlValues, lookat:=xlPart)
                If Not raZielzelle Is Nothing Then
                    If .Cells(raZelle.Row, raZielzelle.Column + 1) < daDatum Then
                        raZelle.EntireRow.Interior.ColorIndex = 6
                    End If
                End If
            Case Else
        End Select
    Next raZelle
    .Columns("C:P").Hidden = False
    .Range("$A$3:$Z$" & loLetzte).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), _
    Operator:=xlFilterCellColor
    With .AutoFilter.Range
        .Resize(.Rows.Count - 1).Offset(1, 0).Copy
    End With
    With Worksheets("Tabelle2")
        loLetzteZ = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
        If .Cells(1, 1) = "" Then loLetzteZ = 1
        .Cells(loLetzteZ, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With
    .Columns("C:P").Hidden = True
    .AutoFilter.ShowAllData
End With

Application.CutCopyMode = False
Set raZielzelle = Nothing
End Sub


In welche Stelle der Rot markierten Codeteils muss ich die Änderung/Zusatz vornehmen, sodass ich mein vorhaben erreichen kann?

Zur besseren Verständigung anbei die entsprechende Datei.

Dank im Vorab.

Grüße
Memo

[cysu11]

Hi Memo,


wenn ich Dich richtig verstanden habe, dann so:

Code:

Sub Filtern()
Dim raZelle As Range, raZielzelle As Range
Dim daDatum As Date, loLetzte As Long
Dim loLetzteZ As Long
 
daDatum = DateSerial(Year(Date), Month(Date) + 1, Day(Date))

Application.ScreenUpdating = False

With Worksheets("Tabelle1")
    loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Each raZelle In .Range("M4:M" & loLetzte).SpecialCells(xlCellTypeConstants)
        Select Case raZelle.Value
            Case "IL2", "IL3", "IL4", "IL5"
                Set raZielzelle = .Range("2:2").Find(what:=raZelle.Value, _
                LookIn:=xlValues, lookat:=xlPart)
                If Not raZielzelle Is Nothing Then
                    If .Cells(raZelle.Row, raZielzelle.Column) < daDatum And _
                    .Cells(raZelle.Row, raZielzelle.Column) > Date Then
                        raZelle.EntireRow.Interior.ColorIndex = 6
                    End If
                End If
            Case Else
        End Select
    Next raZelle
    .Columns("C:P").Hidden = False
    .Range("$A$3:$Z$" & loLetzte).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), _
    Operator:=xlFilterCellColor
    With .AutoFilter.Range
        .Resize(.Rows.Count - 1).Offset(1, 0).Copy
    End With
    With Worksheets("Tabelle2")
        loLetzteZ = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
        If .Cells(1, 1) = "" Then loLetzteZ = 1
        .Cells(loLetzteZ, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End With
    .Columns("C:P").Hidden = True
    .AutoFilter.ShowAllData
End With

Application.CutCopyMode = False
Set raZielzelle = Nothing
End Sub

LG
Alexandra

[Memo]

Abend,

danke für die schnelle Rückmeldung.

Ich habe den Code über die Datei laufen lassen. Es kommt zwar keinerlei Fehlermeldung jedoch tut er nicht nach den Bedingung(en) die Zeilen entsprechend Gelb färben.

Obwohl du den Code Gelb färben auch mit drin hast, mach er es nicht. Wie kann das sein?

Wenn ich dein Code auf die hochgeladene Datei laufen lasse, tut es weder Zeilen Gelb färben (die ich vorher markiert habe welche Zeilen normalerweise Gelb sein sollten und welche nicht) noch tut es nach den 2 Bedingungen die Zellen überprüfen.

Wo sind in dem Code die Bedingungen ?
kleiner als heute + 1 Monat  
heute + kleiner als 1 Monat 

Kann man die beiden Bedingungen nicht in den bestehenden Code einpflanzen?



Gruß
Memo

[cysu11]

Hi Memo,

kannst du nochmals Beispiel zeigen wenn heute der 25.03.2019 sollen die Zeilen markiert werden, die ein Datum haben zwischen 25.02. und 25.04. oder versteh ich das falsch!

LG Alexandra

[Memo]

Hi Alexandra,

der heutige bzw. der aktuelle Datum wenn man die Datei öffnet soll immer als BezugsDatum genommen werden.

Anbei die Erklärung für das Beispiel welches ich hochlade in Excel und jpeg.


Betrachte Bereich M4 bis M5000.

Zelle M4 auslesen: Wenn in M4 "IL2" steht (wie in diesem Fall) dann springe zu Spalte "IL2 (Expected)" in die Zelle CC4 und lese das Datum aus dieser Zelle aus.

1. Bedingung

Wenn das Datum aus CC4:

mit heute + kleiner als 1 Monat 
(Beispiele für Gelb: 26.03.19 bis 26.04.2019)                   ist dann Gelb füllen.


Wenn das Datum aus CC4:

Heute + größer als 1 Monat dann nichts tun. Also ab 27.04.2019 wäre es OK daher nicht Gelb füllen.

2. Bedingung

Wenn das Datum aus CC4:

in der Vergangenheit liegt als Heute (aktuelles Datum), dann schaue bei 1 höher als IL2, also bei IL3 Expected.

Wenn das Datum aus Zelle IL3 Expected  kleiner als Heute +  bis zu 1 Monat ist dann Gelb,  andernfalls nichts tun.

Schaue dir bitte die Beispieldatei Excel und jpeg an, da  kannst du es einfach nachvollziehen, was ich meine.  In der Hilfsspalte kannst du sehen welche Zeilen Gelb sind und welche nicht.

   


Hoffe ich konnte es verständlich rüberbringen.


Gruß
Memo