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
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
:15:
Fennek for President
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