Doppelte hervorheben + neues sheet

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
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

Beiträge aus den Excel-Beispielen zum Thema " Doppelte hervorheben + neues sheet"