Duplikate zählen

[elvisonline]

Hallo Fennek, hab mich nicht ganz richtig ausgedrückt. Der Code "stolpert" bei der Formatierung über leere Zeilen. Sobald in der nächsten Zeile kein Eintrag (leere Zelle) vorhanden ist werden die weiteren Duplikate nicht gefärbt. Leider hat meine Spalte viele solcher Lücken. Ich möchte nicht ganze Zeile färben. Mit dem Anzeigen der Duplikat-Anzahl hab ich noch etwas Probleme. Ich kann dir nicht ganz folgen. Ich bräuchte die Anzahl direkt in der Tabelle, da ich diesen Wert weiterverarbeite. mfg

[Fennek]

Hallo,

Leerzeilen waren nicht vorgesehen, aber dieser Code sollte das schaffen. auch die Anzahl der Duplikate wird ausgegeben.

Code:

########### mit leeren Zellen #######

Sub iFen()

With CreateObject("Scripting.Dictionary")
'Ar = Columns(1).SpecialCells(2)
lr = Cells(Rows.Count, "A").End(xlUp).Row
Ar = Range("A1:A" & lr)
For i = 1 To UBound(Ar, 1)
   If Ar(i, 1) <> 0 Then
       If Not .exists(Ar(i, 1)) Then
           y = .Item(Ar(i, 1))
       Else
       'färben der Duplikate
           Cells(i, 1).Interior.Color = vbYellow
       End If
   End If
Next i
'Ausgabe in Text-Spalte
Columns(3).NumberFormat = "@"
Range("C1").Resize(.Count) = Application.Transpose(.keys)
MsgBox "Anzahl der Duplikate: " & lr - .Count

End With
End Sub

mfg

[elvisonline]

:15:

Fennek for President

[Fennek]

Hallo,

bevor dies ein unendliche Geschichte wird, es wäre besser eine "ordentliche" Tabelle, d.h. als xl-Tabelle definiert anzulegen. D.h. auch, dass leere Zellen oder Nullwerte zuerst eliminiert werden müssen.

Dann ginge auch die farbliche Anzeige von Duplikaten einfacher.

Code:

'########### zählen ohne Leerzeilen und 0-Werte
Sub iFen()

With CreateObject("Scripting.Dictionary")
'Ar = Columns(1).SpecialCells(2)
lr = Cells(Rows.Count, "A").End(xlUp).Row
ar = Range("A1:A" & lr)
For i = 1 To UBound(ar, 1)
If ar(i, 1) = 0 Then LL = LL + 1
   If ar(i, 1) <> 0 Then
       If Not .exists(ar(i, 1)) Then
           y = .Item(ar(i, 1))
       Else
       'färben der Duplikate
           Cells(i, 1).Interior.Color = vbYellow
       End If
   End If
Next i
'Ausgabe in Text-Spalte
Range("C1:C" & lr).NumberFormat = "@"
Range("C1").Resize(.Count) = Application.Transpose(.keys)
MsgBox "Anzahl der Duplikate: " & lr - .Count - LL & vbLf & "Eindeutig: " & .Count
Debug.Print LL
End With
End Sub

mfg