Herbers Excel-Forum - das Archiv

Bewerten Sie hier bitte das Excel-Portal

Doppelte hervorheben + neues sheet

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
⇒ InputBox
Bild

Betrifft: Doppelte hervorheben + neues sheet
von: luca
Geschrieben am: 13.10.2003 16:35:04
Hallo zusammen

habe wieder einmal wie IMMER eure grosse hilfe nötig.
habe selber herum experimentiert, aber, ausser meine nerven zu .....
habe ich nichts, wirklich gar nichts erreicht!!!

mein unüberwindbares problem ist folgendes:

gegeben ist ein markierter bereich. zb B3-F14
der sollte aber varieren können,dh. bevor ich das makro laufen lasse, markiere ich den bereich,in dem das makro wüten soll.

dann sollte es Doppelte (also egal wo in dem bereich) Irgndwie markieren.am liebsten farbig( egal ob eine farbe oder mehrere, aber mehrere wäre perfekt).
und falls noch möglich, sollte ein neues sheet erstellt werden, in dem ich sofort sehe, welcher zellinhalt doppelt ist und wo sie sich befinden.weil es zu kompliziert ist, werde ich eine datei anhängen um mich besser auszudrücken.

https://www.herber.de/bbs/user/1404.xls

Nun, versteht ihr sehr wahrscheinlich, wieso ich mit dem problem nicht im geringsten zurecht komme.

Bitte um eure experten und GURU hilfe....

danke im voraus :-)

grüsse luca

Bild

Betrifft: AW: Doppelte hervorheben + neues sheet
von: geri
Geschrieben am: 13.10.2003 16:48:05
Hallo Luca

meinst du so --> neue Sheet

Sub ListDoubles()
Dim rng As Range, rngCell As Range
Dim fct As WorksheetFunction
Dim var As Variant
Dim iRow As Integer
Set rng = ActiveSheet.UsedRange
Set fct = WorksheetFunction
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
For Each rngCell In rng.Cells
If fct.CountIf(rng, rngCell.Value) > 1 Then
var = Application.Match(rngCell.Value, Columns(1), 0)
If IsError(var) Then
iRow = iRow + 1
Cells(iRow, 1).Value = rngCell.Value
Else
iRow = var
End If
Cells(iRow, fct.CountA(Rows(iRow)) + 1).Value = _
rngCell.Address(False, False)
End If
Next rngCell
End Sub


gruss geri
Bild

Betrifft: AW: Doppelte hervorheben + neues sheet
von: ChrisL
Geschrieben am: 13.10.2003 16:50:47
Hi Luca

Noch ein anderer Ansatz...

Option Explicit

Sub ListDoubles()
Dim Zelle As Range, Rng As Range
Dim iRow As Integer
On Error Resume Next
Set Rng = Application.InputBox("Bitte Bereich auswählen", "Auswahl", Type:=8)
If Err = 424 Then Exit Sub
Worksheets.Add after:=Worksheets(Worksheets.Count)
For Each Zelle In Rng
If WorksheetFunction.CountIf(Rng, Zelle.Value) > 1 Then
Zelle.Interior.ColorIndex = 3
iRow = iRow + 1
Cells(iRow, 1).Value = Zelle.Value
Cells(iRow, 2).Value = Zelle.Address(False, False)
End If
Next Zelle
End Sub



Gruss
Chris
Bild

Betrifft: AW: Doppelte hervorheben + neues sheet
von: luca
Geschrieben am: 13.10.2003 17:36:27
ja, ihr seid super!!!
kann man auch beide eigenschaften irgendwie ineinander haben, das ROT MARKIREN und die ergebnisse IN EIN NEUES SHEET??
weil, bei einem von euch funktioniert das eine aber das andere nicht und umgekehrt...

habe mir eure ZAUBERFORMEL mal angeschaut, und woltte es selber probieren( einen MIX)
aber BAHNHOF .....

könntet ihr mir da helfen??

grüsse und schöner abend luca
Bild

Betrifft: AW: Doppelte hervorheben + neues sheet
von: ChrisL
Geschrieben am: 13.10.2003 17:38:23
Hi Luca

Aber die Zelle wird doch auch farbig markiert...

Zelle.Interior.ColorIndex = 3

Gruss
Chris
Bild

Betrifft: Chris Doppelte hervorheben + neues sheet
von: geri
Geschrieben am: 13.10.2003 18:20:35
Hallo Chriss
denke Luca meint dies

Download des Tabellenkonverters                 Formeln in den Zellen als QuickNotiz
Von geri
Bild
 A B C D E F
1 2 B11 B15 A27 B27 C27
2 1 A15 A20 B20 C20 A21


in meinem Beispiel wird die Wertigkeit in Spalte A und die gefundenen Zellen von B...... ?? dargestellt

gruss geri
Bild

Betrifft: AW: Doppelte hervorheben + neues sheet
von: luca
Geschrieben am: 14.10.2003 09:31:15
hallo crisL

was ich meinte ist:

was bei dir super funktioniert, ist das mit der farbe( das die doppelten rot markiert werden.)
Aber, das neue sheet, ist leer, und da hat mich geri richtig verstanden, dort hätte ich gerne die angeben, was doppelt ist und wo sich die dopplten befinden....

wäre das möglich?? oder stört irgend ein faktor oder ähnliches??
also wenn ich es bei mir probiere, eure "zauber" formeln zu "vereinen" sprich, colorindex 3 ind geris formel einzubinden, dann geht es nicht mehr...

könntet ihr mir evt helfen??

danke im voraus , und auch für euren tollen einsatz und ideen...

grüsse luca
Bild

Betrifft: AW: Doppelte hervorheben + neues sheet
von: geri
Geschrieben am: 14.10.2003 09:32:11
Hallo Luca

teste es so

Sub ListDoubles_new()
Dim Rng As Range, rngCell As Range
Dim fct As WorksheetFunction
Dim var As Variant
Dim iRow As Integer
Set Rng = ActiveSheet.UsedRange
Set fct = WorksheetFunction
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
For Each rngCell In Rng.Cells
If fct.CountIf(Rng, rngCell.Value) > 1 Then
rngCell.Interior.ColorIndex = 3
var = Application.Match(rngCell.Value, Columns(1), 0)
If IsError(var) Then
iRow = iRow + 1
Cells(iRow, 1).Value = rngCell.Value
Else
iRow = var
End If
Cells(iRow, fct.CountA(Rows(iRow)) + 1).Value = _
rngCell.Address(False, False)
End If
Next rngCell
End Sub


gruss geri
Bild

Betrifft: AW: Doppelte hervorheben + neues sheet
von: luca
Geschrieben am: 14.10.2003 09:39:52
wow...."staun" :-O

absolut der HAMMER !!!!

danke vielmals, jetzt ist es PERFEKT !!

Was würde ich ohne euch tun...
(besser nicht daran denken..)

grüsse und nochmals vielen dank , luca
Bild

Betrifft: Danke f. Antwort o.T
von: geri
Geschrieben am: 14.10.2003 09:43:24
.
 Bild
Excel-Beispiele zum Thema " Doppelte hervorheben + neues sheet"
Doppelte Einträge finden und löschen Doppelte Datensätze löschen
Doppelte Zelleinträge listen Doppelte Datensätze und Leerzeilen löschen
Doppelte Datensätze farblich markieren und auflisten Doppelte Eingabe von Werten verhinden
In mehrere Spalten doppelte Inhalte entfernen Doppelte Einträge in UserForm-ListBox löschen
Auf Doppelte prüfen, bevor Tabelleneintrag Zeile mit Cursor farblich hervorheben