[Visual Basic] Excel Makro optimieren

Buzzer · 15. Juli 2013

Excel Makro optimieren

Hi,

ich brauch mal eure Hilfe.

Ich habe ein Makro bzw 2 Varianten.

Das Makro durchsucht in der Excel Tabelle Spalte A nach doppelten Einträgen, wenn ein Eintrag doppelt vorhanden ist löscht das Makro die ganze Zeile und lässt zum Schluss nur einen Eintrag(Variante 1) oder keinen Eintrag(Variante 2) übrig.

Das Makro arbeitet leider bei großen Datenmengen sehr uneffektiv.

Es schnappt sich Eintrag 1 und scannt erst einmal die ganze Tabelle durch, da ich aber Tabellen mit 60.000-100.000 Zeilen habe, bring ich damit meinen PC ganz schön an seine Grenzen.

Könnt ihr eine Routine einbauen mit der das Makro effektiver arbeitet?

Ich dachte an so etwas wie: Erst die Tabelle nach Spalte A Aufsteigend sortieren(würde auch im Vorfeld manuell gehen) und dann solange doppelte Einträge löschen bis eine andere Kundenummer kommt, Das Durchscannen der ganzen Tabelle wäre dann unnötig, da ja alle doppelteinträge beieinander sind.

Anbei mal die Makros:

Variante 1

Code:

Sub Duplikate_finden_und_loeschen()
 Dim iRow As long, iRowL As long 
 iRowL = Cells(Cells.Rows.Count, 1).End(xlUp).Row
 For iRow = iRowL To 1 Step -1
 If WorksheetFunction.CountIf(Columns(1), Cells(iRow, 1)) > 1 Then
 Rows(iRow).Delete
 End If
 Next iRow
 End Sub

Variante 2

Code:

Sub Duplikate_finden_und_loeschen()
 Dim iRow As Double, iRowL As Double, Count2 As Double, i As Double
 Dim Count() As Double
 iRowL = Cells(Cells.Rows.Count, 1).End(xlUp).Row
 ReDim Count(iRowL)
 Count2 = 0
 
 For iRow = iRowL To 1 Step -1
 If WorksheetFunction.CountIf(Columns(1), Cells(iRow, 1)) > 1 Then
 Count(Count2) = iRow
 Count2 = Count2 + 1
 End If
 Next iRow
 
 For i = 1 To Count2
 Rows(Count(i - 1)).Delete
 Next
 
 End Sub

Anzeige

Nützliche Suchen

[Visual Basic] Excel Makro optimieren

Videos zum Themenbereich