VBA - doppelte Einträge finden und mark.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub XXXX() Dim Sp As Integer, Z1 As Integer, LR As Integer Sp = 1 'Spalte A Z1 = 2 'Wegen Überschrift With ActiveSheet LR = .Cells(.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte With .Cells(Z1, Sp + 1).Resize(LR - Z1 + 1, 1) .FormulaR1C1 = "=IF(COUNTIF(C[-1],RC[-1])>1,""x"","""")" .Value = .Value End With End With End Sub

Option Explicit Public Sub Dubletten_markieren() Const SEARCH_COLUMN As Long = 1 'A Dim objCell As Range Dim objDictionary As Object Set objDictionary = CreateObject(Class:="Scripting.Dictionary") With objDictionary For Each objCell In Range(Cells(1, SEARCH_COLUMN), Cells(Rows.Count, SEARCH_COLUMN).End(xlUp)) If .Exists(Key:=objCell.Text) Then objCell.Offset(0, 1).Value = "x" .Item(Key:=objCell.Text).Offset(0, 1).Value = "x" Else Set .Item(Key:=objCell.Text) = objCell End If Next End With Set objDictionary = Nothing End Sub

meine werte stehen in der spalte 38


Option Explicit
Public Sub Dubletten_markieren()
Const SEARCH_COLUMN As Long = 38 'A
Dim objCell As Range
Dim objDictionary As Object
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
With objDictionary
For Each objCell In Range(Cells(1, SEARCH_COLUMN), Cells(Rows.Count, SEARCH_COLUMN).End(xlUp))
If .Exists(Key:=objCell.Text) Then
objCell.Offset(0, 1).Value = "x"
.Item(Key:=objCell.Text).Offset(0, 1).Value = "x"
Else
Set .Item(Key:=objCell.Text) = objCell
End If
Next
End With
Set objDictionary = Nothing
End Sub

läuft einmal durch - aber es passiert sonst nichts

Sub XXXX() Dim Sp As Integer, Z1 As Integer, LR As Integer Sp = 9 'Spalte A Z1 = 2 'Wegen Überschrift With ActiveSheet LR = .Cells(.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte With .Cells(Z1, Sp + 1).Resize(LR - Z1 + 1, 1) .FormulaR1C1 = "=IF(COUNTIF(C[-1],RC[-1])>1,""x"","""")" .Value = .Value End With End With End Sub

Sub Unit_Duplicates() Dim C As Range, O As Object With Columns(38) If Application.CountA(.Cells) = 0 Then Exit Sub Set O = CreateObject("scripting.dictionary") For Each C In .SpecialCells(2) If O.Exists(C.Text) Then C.Offset(0, 1) = "X" Else O.Add Key:=C.Text, Item:=0 End If Next End With O.RemoveAll: Set O = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Arbeitsblatt mit dem Namen 'Tabelle1'
	A
1	Aaa
2	sds
3	ss
4	sds
5	Aaa
6	1
7	2
8	3
9	1
10	2
11	ww

Zelle	bedingte Formatierung...	Format
A1	1: ZÄHLENWENN($A:$A;$A1)>1	abc

VBA - doppelte Einträge finden und mark.

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA - doppelte Einträge finden und mark.

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread