wenn ich den Fehler nicht gefunden hätte, dann würde es ja jetzt nicht funktionieren, oder? :)
If .Cells(raZelle.Row, raZielzelle.Column) < daDatum And _ .Cells(raZelle.Row, raZielzelle.Column) >= Date Then raZelle.EntireRow.Interior.ColorIndex = 6 Else If .Cells(raZelle.Row, raZielzelle.Column + 2) < daDatum And _ .Cells(raZelle.Row, raZielzelle.Column + 2) >= Date Then raZelle.EntireRow.Interior.ColorIndex = 6 End If End If
LG Alexandra
Folgende(r) 1 Nutzer sagt Danke an cysu11 für diesen Beitrag:1 Nutzer sagt Danke an cysu11 für diesen Beitrag 28 • Memo
27.03.2019, 16:37 (Dieser Beitrag wurde zuletzt bearbeitet: 27.03.2019, 16:38 von snb.)
So läuft's
Code:
Sub M_snb() sn = Tabelle1.Cells(4, 1).CurrentRegion
For j = 1 To UBound(sn) y = sn(j, 78 + 2 * Right(sn(j, 13), 1)) If y > Date And y <= DateAdd("m", 1, Date) Then c00 = c00 & " " & j Next
If c00 <> "" Then st = Split(Trim(c00)) Tabelle2.Cells(2, 1).Resize(UBound(st) + 1, UBound(sn, 2)) = Application.Index(sn, Application.Transpose(st), [transpose(row(1:105))]) End If End Sub
Kannst du mir bitte verraten, wie ich bei "..." die Anzahl der aus der funktionierenden VBA gefärbten Zeilen ausgeben?
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 Else If .Cells(raZelle.Row, raZielzelle.Column + 2) < daDatum Then raZelle.EntireRow.Interior.ColorIndex = 6 End If 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 = False .AutoFilter.ShowAllData MsgBox (MsgBox("Es wurde insgesamt ... Zeilen ausgewertet worden.", vbOKOnly + vbInformation, "Memo")) End With Application.CutCopyMode = False Set raZielzelle = Nothing End Sub