Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
460to464
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
460to464
460to464
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

doppelte Zhalen finden /markieren Problem

doppelte Zhalen finden /markieren Problem
27.07.2004 10:58:08
Marco
Hallo,
ich habe folgendes Problem. Ich habe in einer Tabelle in Spalte A Zahlen stehen. Es kommt vor, dass Zwei Zahlen mherfach vorkommen. Wenn dem so ist, sollen die Dopplungen farbig markiert werden, jede Dopplung in einer anderen Farbe. Das habe ich mit untenstehendem Code realisiert. Wenn jetzt eine Zahl aber 3 mal vorkommt, werden die ersten beiden Zahlen in einer Farbe markiert, dann die dritte auch noch in der gleichen Farbe. Danach werden aber die zweite und dritte in einer anderen Farbe markiert. Wie kann ich den Code denn abändern, dass es auch bei mehr als zwei Dopplungen funktioniert?
Gruß
Marco
x = 6
For aRow = 2 To Range("A65536").End(xlUp).Row
auf_dopplung_zu_überprüfende_nummer = Cells(aRow, 1).Value
For bRow = aRow To Range("A65536").End(xlUp).Row
nummer = Cells(bRow, 1).Value
If aRow bRow Then
If auf_dopplung_zu_überprüfende_nummer = nummer Then
Cells(aRow, 1).Interior.ColorIndex = x
Cells(bRow, 1).Interior.ColorIndex = x
End If
End If
Next
x = x + 1
Next

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: doppelte Zhalen finden /markieren Problem
Beni
Hallo Marco,
das ist, weil bei der Abfrage der zweiten gleichen Zahl noch eine gleiche gefunden wird, der Farbcode in der Zwischenzeit erhöht wurde und die erste Zahl nicht mer aktualisiert wird.
Gruss Beni

Sub Doppelete_farbig()
x = 6
For aRow = 2 To Range("A65536").End(xlUp).Row
auf_dopplung_zu_überprüfende_nummer = Cells(aRow, 1).Value
For bRow = 2 To Range("A65536").End(xlUp).Row 'hier die Aenderung
nummer = Cells(bRow, 1).Value
If aRow <> bRow Then
If auf_dopplung_zu_überprüfende_nummer = nummer Then
Cells(aRow, 1).Interior.ColorIndex = x
Cells(bRow, 1).Interior.ColorIndex = x
End If
End If
Next
x = x + 1
Next
End Sub

Anzeige
Vielen Dank! Funktioniert nun!
Marco
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige