Spalten-Einmaligkeitsprüfung zu langsam
09.11.2005 14:56:52
David
Ich komme gleich mal zu meinem Problem:
Ich habe eine Spalte in einem Sheet, deren Werte Einmalig sein müssen. Doppelte oder dreifache (oder x-fache) Werte sollen Rot markiert werden und auf derselben Zeile soll in Spalte I die Zeilennummer von dem/den Gegenstück/en geschrieben werden.
Das funktioniert an sich schon alles. Das Problem ist: es sind insgesamt 3557 Zeilen, aber es sollte so schnell wie Möglich durchlaufen (das Beste wäre innerhalb einer Minute, aber ich bin mir zu 90% sicher, dass das unmöglich ist).
Mein momentaner Code (s.u.) braucht aber rund 20 Minuten dafür. Ich habe schon alles optimiert, das mir möglich war (und so schon ca. 30 minuten eingespart) aber ich weiss nicht, ob und was man noch verbessern könnte.
Kann mir hier vieleicht jemand helfen oder mir zumindest sagen, dass eine weitere Verbesserung gar nicht Möglich ist? Danke im Voraus.
Mein Code sieht momentan so aus:
Sub Einmaligkeit_Ueberpruefen_Spalte_B()
Dim Cell As Range
Dim z As Range
Dim check As Long
check = 0
' Loop über alle Zellen der 2. Spalte (B) im aktiven Sheet
For Each z In ActiveSheet.UsedRange.Columns(2).Cells
' nur überprüfen, wenn die Zelle nicht leer ist
If Not z.Value = "" Then
' jede zeile von z aus überprüfen auf Wert in Spalte B
For Each Cell In ActiveSheet.Range(z, z.End(xlDown)).Cells
' Wert Vergleichen: Zelle vom 1. Loop und Zelle vom momentanen
If Range("B" & Cell.Row).Value = z.Value Then
check = check + 1
If Not Cell.Row = z.Row Then Range("I" & z.Row).Value = Range("I" & z.Row).Value & " " & Cell.Row
End If
Next
If check > 1 Then
z.Interior.ColorIndex = 3
ElseIf z.Interior.ColorIndex = 3 Then
z.Interior.ColorIndex = xlNone
End If
check = 0
Else
Exit For
End If
Next z
MsgBox "Überprüfung der Spalte B abgeschlossen!"
End Sub