Sub alle_Namen()
Dim Bereich As Range, C As Range, lngCount As Long, myArray() As Variant, x As Long
Dim firstAddress As String
Set Bereich = Range("A1:A" & Range("A65536").End(xlUp).Row)
Set C = Bereich.Find("*")
If Not C Is Nothing Then
firstAddress = C.Address
Do
If Application.WorksheetFunction.Match(C, Bereich, 0) = C.Row Then
lngCount = lngCount + 1
ReDim Preserve myArray(1 To 2, 1 To lngCount)
myArray(1, lngCount) = C
myArray(2, lngCount) = WorksheetFunction.CountIf(Bereich, C)
End If
Set C = Bereich.FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
For x = 1 To lngCount
MsgBox "Name: " & myArray(1, x) & Chr(10) _
& "Anzahl: " & myArray(2, x), , "Gebe bekannt"
Next x
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen