|
Hallo zusammen
Ich habe eine Tabelle wo ich doppelte Zeilen rausfiltern möchte. Dies funktioniert mit dem Code den ich gebasltet habe auch, nur warte ich ca. 30 Minuten bis zur Fertigstellung :( Kann mir jemand helfen, wie ich den Code optimieren kann, dass ich eine bessere Performance hinbekommen kann.
Sub DoppelteEinträgeLöschen()
' ###Sachen abschalten die es nicht braucht###
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' ###Variablen###
Dim txA As String, txB As String
Dim lRowMaxI As Long, lRowMaxJ As Long, i As Long, j As Long
'###Variablen definieren###
lRowMaxI = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
i = 2
With Income
Do
j = i + 1
Do
Kontrolle i, j
j = j + 1
Loop Until j = lRowMaxI
Loop Until i = lRowMaxI
End With
' Sachen wieder einschalten - Performance
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Function Kontrolle(i As Long, j As Long)
'###Variablen###
Dim txtA As String, txtB As String
txtA = Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value & Cells(i, 8).Value
txtB = Cells(j, 1) & Cells(j, 2).Value & Cells(j, 3).Value & Cells(j, 4).Value & Cells(j, 5).Value & Cells(j, 6).Value & Cells(j, 7).Value & Cells(j, 8).Value
If txtA = txtB Then
Cells(j, 1).EntireRow.Delete
Else
End If
End Function
Danke im Voraus für jede Unterstützung
Gruss, root13
|