doppelte Zahl finden und kennzeichnen

Hallo Leute,
ich habe gestern von Peter (danke dir noch einmal Peter...) einen VBA Code bekommen, welcher mir in der Spalte A alle doppelten Zahlen sucht und diese mit einem "D" kennzeichnet. D.h. hinter jeweils beide Zahlen wird ein "D" geschrieben.
Nun aber die Herausforderung: Ich brauche das "D" nur an der zweiten oder ersten doppelten Zahl. Wo wäre mir egal.
Kann mir jemand dabei helfen?
Hier der Code:
============================================================================
Sub Doppeltes() Dim lZeile As Long Dim lLetzte As Long Dim Bereich As Range Dim aVar As Variant lLetzte = Range("A65536").End(xlUp).Row ' letzte belegte Zeile ermitteln Set Bereich = Range("A1:A" & lLetzte) ' abzusuchenden Bereich festlegen ReDim aVar(lLetzte) For lZeile = 1 To lLetzte If WorksheetFunction.CountIf(Bereich, Range("A" & lZeile).Value) > 1 Then aVar(lZeile) = "D" End If Next lZeile For lZeile = 1 To lLetzte If aVar(lZeile) = "D" Then ' wurde ein D eingetragen ? Range("A" & lZeile).Value = Range("A" & lZeile).Value & aVar(lZeile) End If Next lZeile End Sub
==========================================================================
Danke Euch,
Gruß Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Micha,
unten sind zwei Makros (Nr. 4 und 5), die liefern

	A	B	C	D
1	Makro 4	Makro 5		Quelle
2	11	11		11
3	911	90011		11
4
5	4	4		4
6	94	90004		4
7	84	80004		4
8
9	15	15		15
10	915	90015		15
11
12	1000	1000		1000
13	91000	91000		1000
14
15	2000	2000		2000
16	92000	92000		2000
17	82000	82000		2000
18	82000	82000		2000

Diagramm - Grafik - Excel Tabellen einfach im Web darstellen Excel Jeanie HTML 3.0 Download
Bei Makro 4 wird einfach vor die Zahl eine 9 oder 8 gesetzt.
Bei Makro 5 lassen sich die Dubletten leicht ans Ende oder den Anfang sortieren,
da sie eine einheitliche Stellenzahl haben und größer als alle anderen Zahlen sind.
Wenn deine Zahlen alle eine einheitliche Stellenzahl haben, ist es egal, welches Makro du nimmst.

Option Explicit
Sub Doppelte4()
'              stellt vor alle Werte in A, die weiter oben einmal vorkommen, eine 9
'              stellt vor alle Werte in A, die weiter oben mehr als einmal vorkommen, eine 8
Dim lngZ As Long, lngC As Long
For lngZ = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
lngC = WorksheetFunction.CountIf _
(Range(Cells(1, 1), Cells(lngZ - 1, 1)), Cells(lngZ, 1))
If lngC = 1 Then
Cells(lngZ, 1) = 1 * ("9" & Cells(lngZ, 1))
ElseIf lngC > 1 Then
Cells(lngZ, 1) = 1 * ("8" & Cells(lngZ, 1))
End If
Next lngZ
End Sub
Sub Doppelte5()
Dim lngZ As Long, lngC As Long, lngM As Long, lngF As Long
lngM = WorksheetFunction.Max(Columns(1))
lngF = 1 * ("1" & String(Len(Format(lngM, "00")), "0"))
For lngZ = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
lngC = WorksheetFunction.CountIf _
(Range(Cells(1, 1), Cells(lngZ - 1, 1)), Cells(lngZ, 1))
If lngC = 1 Then
Cells(lngZ, 1) = 9 * lngF + Cells(lngZ, 1)
ElseIf lngC > 1 Then
Cells(lngZ, 1) = 8 * lngF + Cells(lngZ, 1)
End If
Next lngZ
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

doppelte Zahl finden und kennzeichnen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread