VBA Hilfe, der Code ist fehlerhaft / 18 Spalten und drei Spalten werden verglichen

[Tommiks]

Die Datei hat in einem Arbeitsblatt 18 Spalten. In der 9. Spalte befinden sich Uhrzeit-Angaben. Ich versuche die Zeilen in der Spalte 3 ,4, und 8 auf doppelte Werte zu vergleichen. Wenn die  Werte der Spalten gleich sind ,und wenn die Differenz der zwei Zeilen in der Spalte 9. kleiner als 300 Sekunden ist, dann sollen beide Zeilen mit den 18 Spalten in der gelben Füllfarbe markiert werden.

Der Code zeigt an der Stelle "Typen Unverträglichkeit an. Was ist in dem Code falsch?

Code:

timeDiff = Abs(ws.Cells(i, 9).Value - ws.Cells(i - 1, 9).Value) * 24 * 60 * 60 ' in Sekunden umrechnen

Code:

Sub VergleicheUndMarkiere()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
' Setze das Arbeitsblatt fest
Set ws = ThisWorkbook.Sheets("Tabelle1")
' Finde die letzte Zeile mit Daten in Spalte 3
lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
' Schleife über die Zeilen
For i = 2 To lastRow
' Vergleiche die Werte in Spalten 3, 4 und 8 auf doppelte Werte
If WorksheetFunction.CountIf(ws.Range(ws.Cells(2, 3), ws.Cells(lastRow, 3)), ws.Cells(i, 3).Value) > 1 _
And WorksheetFunction.CountIf(ws.Range(ws.Cells(2, 4), ws.Cells(lastRow, 4)), ws.Cells(i, 4).Value) > 1 _
And WorksheetFunction.CountIf(ws.Range(ws.Cells(2, 8), ws.Cells(lastRow, 8)), ws.Cells(i, 8).Value) > 1 Then
' Berechne die Differenz der Zeiten in Spalte 9 in Sekunden
Dim timeDiff As Double
timeDiff = Abs(ws.Cells(i, 9).Value - ws.Cells(i - 1, 9).Value) * 24 * 60 * 60 ' in Sekunden umrechnen
' Wenn die Differenz kleiner oder gleich 300 Sekunden ist, markiere beide Zeilen
If timeDiff <= 300 Then
' Markiere die aktuelle Zeile und die vorherige Zeile mit gelber Füllfarbe
ws.Range(ws.Cells(i - 1, 1), ws.Cells(i, 18)).Interior.Color = RGB(255, 255, 0) ' Gelb
End If
End If
Next i
End Sub

[Der Steuerfuzzi]

Der Code zeigt an der Stelle "Typen Unverträglichkeit an. Was ist in dem Code falsch?

Das erste Problem ist, dass Du timeDiff innerhalb der Schleife (mehrfach) deklarierst. Das verursacht zwar keine Fehlermeldung, sollte aber außerhalb der Schleife erfolgen. Entweder direkt davor oder ganz am Anfang des Codes.

Jetzt zum Problem: Du fängst bei Zeile 2 an und vergleichst mit der Zelle, die eine Zeile darüber liegt. Das ist die Überschrift und das ist ein Text. Dadurch wird dieser Fehler ausgegeben.

Es ist sowieso fraglich, warum Du die Differenz der Zeile davor ermittelst, so wie ich es verstanden habe, willst Du die Differenz zu der Zeile, in der die doppelten Werte stehen, oder? Zudem vergleichst Du die Werte mit Countif unabhängig voneinander. D.h. es könnte sein, dass die übereinstimmenden Werte in verschiedenen Zeilen stehen.

[Tommiks]

Danke.

Ich möchte in den Spalten 3,4 und 8 die doppelten Werte finden, wenn ich sie habe, dann muss ich die zeitliche Differenz der zwei Zeilen dieser Doppelwerte in der Spalte 9 berechnen. Wenn die Zeit unter 300 Sekunden ist, dann war die Buchung nicht ordnungsgemäß.

Tatsächlich, nach dem ich die Überschrift entfernt habe, wurden leider nur die Nachbar-Zeilen ausgewertet. Das wollte ich nicht so...

[Der Steuerfuzzi]

Versuch es mal so:

Code:

Sub VergleicheUndMarkiere()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long
Dim timeDiff As Double

' Setze das Arbeitsblatt fest
Set ws = ThisWorkbook.Sheets("Tabelle1")

' Finde die letzte Zeile mit Daten in Spalte 3
lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row

' Schleife über die Zeilen
For i = 2 To lastRow - 1
    For j = i + 1 To lastRow
    
    ' Vergleiche die Werte in Spalten 3, 4 und 8 auf doppelte Werte
        If ws.Cells(i, 3).Value = ws.Cells(j, 3).Value Then
            If ws.Cells(i, 4).Value = ws.Cells(j, 4).Value Then
                If ws.Cells(i, 8).Value = ws.Cells(j, 8).Value Then
                    timeDiff = Abs(ws.Cells(i, 9).Value - ws.Cells(j, 9).Value) * 24 * 60 * 60 ' in Sekunden umrechnen
                    If timeDiff < 300 Then
                        ws.Range(ws.Cells(i, 1), ws.Cells(i, 18)).Interior.Color = RGB(255, 255, 0)
                        ws.Range(ws.Cells(j, 1), ws.Cells(j, 18)).Interior.Color = RGB(255, 255, 0)
                    End If
                End If
            End If
        End If
    Next j
Next i
End Sub

[Tommiks]

@Der Steuerfuzzi,

funktioniert tadellos. Danke.
 
Kann man vielleicht diese gefundenen Zeilen per VBA filtern lassen, damit um das Scrollen bis zum 3000.sten Zeile zu vermeiden, um die Ergebnisse zusehen? Danke.

[Der Steuerfuzzi]

Du kannst z. B. die Zeilennummer in Spalte 19 schreiben und danach die zusammen gehörigen Zeilen finden/filtern:

Code:

Sub VergleicheUndMarkiere()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long
Dim timeDiff As Double

' Setze das Arbeitsblatt fest
Set ws = ThisWorkbook.Sheets("Tabelle1")

' Finde die letzte Zeile mit Daten in Spalte 3
lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row

' Schleife über die Zeilen
For i = 2 To lastRow - 1
    For j = i + 1 To lastRow
    
    ' Vergleiche die Werte in Spalten 3, 4 und 8 auf doppelte Werte
        If ws.Cells(i, 3).Value = ws.Cells(j, 3).Value Then
            If ws.Cells(i, 4).Value = ws.Cells(j, 4).Value Then
                If ws.Cells(i, 8).Value = ws.Cells(j, 8).Value Then
                    timeDiff = Abs(ws.Cells(i, 9).Value - ws.Cells(j, 9).Value) * 24 * 60 * 60 ' in Sekunden umrechnen
                    If timeDiff < 300 Then
                        ws.Range(ws.Cells(i, 1), ws.Cells(i, 18)).Interior.Color = RGB(255, 255, 0)
                        ws.Range(ws.Cells(j, 1), ws.Cells(j, 18)).Interior.Color = RGB(255, 255, 0)
                        ws.Cells(i, 19).Value = i
                        ws.Cells(j, 19).Value = i
                    End If
                End If
            End If
        End If
    Next j
Next i
ws.Range("S1").Value = "Filter"
End Sub