Makro braut sehr lange
08.06.2020 11:34:50
Gaven
ich habe 2 Datenbanken mit sehr unterschiedlichen befüll Status, und möchte in die neuere den bereits erfassten Inhalt der älteren übernehmen, und zeitgleich sichtbar machen welche Zeilen der älteren nicht in der neueren sind.
zudem sind in der älteren oft falsche voran- und nachstehende Leerzeichen :-(
Dazu habe ich folgendes simples Makro gebastelt, nur leider benötigt es sehr sehr ... lange und während das Makro durchläuft reagiert Excel nicht mehr.
Meine Frage, wie kann ich, falls möglich, das Makro beschleunigen?
Sub db_abgleich()
Dim A_ende As Long
Dim B_ende As Long
Dim i As Long
Dim j As Long
A_ende = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
B_ende = Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 4 To A_ende ' ~70000
For j = 2 To B_ende ' ~90000
If Trim(Sheets(1).Range("C" & i).Value) = Trim(Sheets(2).Range("A" & j).Value) Then
If Trim(Sheets(1).Range("E" & i).Value) = Trim(Sheets(2).Range("D" & j).Value) _
Then
Sheets(1).Range("B" & i).Value = Trim(Sheets(2).Range("B" & j).Value)
Sheets(1).Range("D" & i).Value = Trim(Sheets(2).Range("C" & j).Value)
Sheets(1).Range("G" & i).Value = Trim(Sheets(2).Range("G" & j).Value)
Sheets(1).Range("H" & i).Value = Trim(Sheets(2).Range("H" & j).Value)
Sheets(1).Range("K" & i).Value = Trim(Sheets(2).Range("I" & j).Value)
Sheets(1).Range("L" & i).Value = Trim(Sheets(2).Range("J" & j).Value)
Sheets(1).Range("M" & i).Value = Trim(Sheets(2).Range("K" & j).Value)
Sheets(1).Range("N" & i).Value = Trim(Sheets(2).Range("L" & j).Value)
Sheets(2).Range("A" & j & ":L" & j).ClearContents
End If
End If
Next j
Next i
End Sub
Anzeige