Doppelte hervorheben + neues sheet
Informationen und Beispiele zu den hier genannten Dialog-Elementen:
|
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
|
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
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
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
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
Betrifft: Chris Doppelte hervorheben + neues sheet
von: geri
Geschrieben am: 13.10.2003 18:20:35
Hallo Chriss
denke Luca meint dies
in meinem Beispiel wird die Wertigkeit in Spalte A und die gefundenen Zellen von B...... ?? dargestellt
gruss geri
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
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
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
Betrifft: Danke f. Antwort o.T
von: geri
Geschrieben am: 14.10.2003 09:43:24
.
Beiträge aus den Excel-Beispielen zum Thema " Doppelte hervorheben + neues sheet"
Das Archiv des Excel-Forums
