AW: Spezialfilter probiert?
21.05.2010 10:17:59
JOWE
Hallo Thomas,
heute morgen fiel mir ein, dass man das über ein Array lösen könnte:
Hier die Idee:
Alle Daten in ein Array einlesen,
das Array sortieren,
Doppler aus dem Array löschen,
das Array nochmal sortieren
Hier die notwendigen Prozeduren:
Option Explicit
Public lngC, lngZ As Long
Public sam As New Collection
Sub Unique_Data()
Call Array_einlesen
Call Array_sortieren
Call Array_doppelte_löschen
Call Array_sortieren
End Sub
Sub Array_einlesen()
Dim wsQ As Worksheet
Dim r As Range
Dim z As Object
Set wsQ = ThisWorkbook.Sheets("Tabelle1")
Set r = wsQ.Range("A1:F32")
For Each z In r
sam.Add z
Next
End Sub
Sub Array_sortieren()
Dim strTemp
For lngZ = 1 To sam.Count - 1
For lngC = 1 To lngZ
If sam(lngC) > sam(lngZ) Then
strTemp = sam(lngZ)
On Error Resume Next
sam(lngZ) = sam(lngC)
sam(lngC) = strTemp
End If
Next
Next
End Sub
Sub Array_doppelte_löschen()
For lngZ = sam.Count - 1 To 1 Step -1
If sam(lngZ) = sam(lngZ + 1) Then
sam(lngZ) = ""
End If
Next
End Sub
Auszuführen ist das Makro 'Unique_Data()'
Gruß
Jochen