AW: 1,5 Mrd. Vergleiche ?!
17.04.2021 11:04:25
Marc
So sieht der VBA-Code aus:
Sub AbgleichStarten()
Dim LastRowPhin As Long, LastRowFMM As Long, ZeilePhin As Long, ZeileFMM As Long
Dim CounterAbgleichVBA As Long
Dim strComparison As Integer
LastRowPhin = Sheets("phin").Cells(Sheets("phin").Rows.Count, "A").End(xlUp).Row
LastRowFMM = Sheets("FMM").Cells(Sheets("FMM").Rows.Count, "A").End(xlUp).Row
CounterAbgleichVBA = 2
'Schleife über alle Einträge in Tabellenblatt "phin"
For ZeilePhin = 4 To LastRowPhin Step 1
If Sheets("phin").Cells(ZeilePhin, 17).Value = "x" Then
'Schleife über alle Einträge in Tabellenblat "FMM"
For ZeileFMM = 4 To LastRowFMM Step 1
' ---- 1. Prüfung auf Feld A ----
'Da beide Blätter aufsteigend nach Feld A sortiert sind kann Iteration abgebrochen _
werden,
'sobald Feld A in FMM größer als die von phin ist (weil dann kein Treffer mehr möglich)
If Sheets("FMM").Cells(ZeileFMM, 7).Value > Sheets("phin").Cells(ZeilePhin, 1).Value _
Then
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 2).Value = Sheets("phin").Cells( _
ZeilePhin, 1).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 3).Value = Sheets("phin").Cells( _
ZeilePhin, 3).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 4).Value = Sheets("phin").Cells( _
ZeilePhin, 7).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 5).Value = Sheets("phin").Cells( _
ZeilePhin, 14).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 6).Value = Sheets("phin").Cells( _
ZeilePhin, 10).Value & " N/A"
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 7).Value = Sheets("phin").Cells( _
ZeilePhin, 11).Value & " N/A"
CounterAbgleichVBA = CounterAbgleichVBA + 1
Exit For
ElseIf Sheets("FMM").Cells(ZeileFMM, 7).Value = Sheets("phin").Cells(ZeilePhin, 1). _
Value Then
' ---- 2. Prüfung auf Feld B ----
'Wenn beide Feld B identisch sind erfolgt nächste (3.) Prüfung
If Sheets("phin").Cells(ZeilePhin, 14).Value = Sheets("FMM").Cells(ZeileFMM, 4). _
Value Then
' ---- 3. Prüfung auf Feld C + Feld D ----
'Wenn unterschiedlich dann Ausweis der jeweiligen Werte
If Sheets("phin").Cells(ZeilePhin, 10).Value Sheets("FMM").Cells(ZeileFMM, 5) _
.Value Or _
Sheets("phin").Cells(ZeilePhin, 11).Value Sheets("FMM").Cells(ZeileFMM, _
6).Value Then
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 2).Value = Sheets("phin").Cells(ZeilePhin, 1). _
Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 3).Value = Sheets("phin"). _
Cells(ZeilePhin, 3).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 4).Value = Sheets("phin"). _
Cells(ZeilePhin, 7).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 5).Value = Sheets("phin"). _
Cells(ZeilePhin, 14).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 6).Value = Sheets("phin"). _
Cells(ZeilePhin, 10).Value & " " & Sheets("FMM").Cells(ZeileFMM, 5).Value
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 7).Value = Sheets("phin"). _
Cells(ZeilePhin, 11).Value & " " & Sheets("FMM").Cells(ZeileFMM, 6).Value
CounterAbgleichVBA = CounterAbgleichVBA + 1
End If
Exit For 'in jedem Fall Abbruch, weil an dieser Stelle Prüfung auf "unterster _
Ebene". Im Anschluss nächster Eintrag phin.
'Feld B nicht identisch
Else
'(Sortierung - analog Prüfung Feld A)
strComparison = StrComp(Sheets("phin").Cells(ZeilePhin, 14).Value, Sheets("FMM") _
.Cells(ZeileFMM, 4).Value)
If (strComparison N/A"
Sheets("Abgleich VBA").Cells(CounterAbgleichVBA, 7).Value = Sheets("phin"). _
Cells(ZeilePhin, 11).Value & " N/A"
CounterAbgleichVBA = CounterAbgleichVBA + 1
Exit For
End If
End If
End If
Next ZeileFMM
End If
Next ZeilePhin
End Sub