Mit diesem Makro werden alle nicht doppelten Daten aus Spalte A in Spalte B geschrieben.
Jeder Wert wird also maximal einmal in Spalte B geschrieben, egal, wie oft er in Spalte A vorhanden ist.
Die Unikate werden sozusagen extrahiert und in Spalte B geschrieben.
Sub ListeUnikate()
Dim Liste As New Collection
Dim i As Integer
Dim j As Integer
Dim Gefunden As Boolean
Liste.Add [A1]
For i = 2 To 20 'oder so viele, wie Du brauchst
Gefunden = False
For j = 1 To Liste.Count
If Cells(i, 1) = Liste(j) Then Gefunden = True
Next j
If Not Gefunden Then Liste.Add Cells(i, 1)
Next i
'Zu Testzwecken
For i = 1 To Liste.Count
Cells(i, 2) = Liste(i)
Next i
End Sub
Herr Kühnlein hat den Code erweitert. Nun wird in Spalte C protokolliert, welche Daten, wie oft in Spalte A vorhanden sind. Eine super Sache!
Sub ListeUnikate_mit_zähler()
  Dim n As Integer
  Dim i As Integer
  Dim j As Integer
  Dim Gefunden As Boolean
  [B1] = [A1]
  [C1] = 1
  n = 1
  For i = 2 To 9 'oder so viele wie gewünscht
    Gefunden = False
    For j = 1 To n
      If Cells(i, 1) = Cells(j, 2) Then
        Gefunden = True
        Cells(j, 3) = Cells(j, 3) + 1
      End If
    Next j
    If Not Gefunden Then
      n = n + 1
      Cells(n, 2) = Cells(i, 1)
      Cells(n, 3) = 1
    End If
  Next i
End Sub
Die Veröffentlichung wurde frundlicherweise von Klaus Kühnlein genehmigt.

 
  Anfrage per E-Mail
 Anfrage per E-Mail  
  Anfrage per Kontaktformular
 Anfrage per Kontaktformular  Hilfe-Forum
 Hilfe-Forum  Weitere Informationen
 Weitere Informationen 