Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
412to416
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
412to416
412to416
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Doppelte markieren / Sigmund Halpern

Doppelte markieren / Sigmund Halpern
Erich
Hallo EXCEL-Freunde,
habe einen code von http://www.sigmundhalpern.de/ der auch gut funktioniert.
Es werden alle doppelten Werte in einer Spalte farblich markiert, und was für
mich wichtig ist, der erste Wert anders wie die weiteren.
Nun wollte ich den Code so ändern, dass statt der farblichen Markierung
in der Spalte rechts davon:
- beim ersten Wert "Original" steht
- und bei den weiteren Werten "Duplikat" steht.
Allerdings komme ich nicht weiter; evtl. hilft mir bereits ein Ansatz:
Sub Doppelte_Zellen_markieren()
Dim Zelle1
Dim Wo, ber, Ja
eing = InputBox("Die Zelle eingeben, ab der geprüft werden soll," _
& (Chr(13)) & "z.B. A1 oder F6.", "Zellenauswahl")
If eing = "" Then Exit Sub
Range(eing).Select
eing = ""
Application.ScreenUpdating = False
Zelle1 = ActiveCell
Wo = ActiveCell.Address
ActiveCell.Offset(1).Select
ber = ActiveCell.CurrentRegion.Rows.Count
For x = 1 To ber
i = 1
For i = i To ber
If ActiveCell.Interior.ColorIndex = 5 _
Or ActiveCell.Interior.ColorIndex = 8 Then GoTo fin
If ActiveCell.Value = Zelle1 Then
If ActiveCell <> "" Then
ActiveCell.Interior.ColorIndex = 5
Ja = 1
End If
End If
fin:
ActiveCell.Offset(1).Select
Next i
Range(Wo).Select
If Ja <> 0 Then ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(1).Select
Wo = ActiveCell.Address
Ja = 0
Zelle1 = ActiveCell
ActiveCell.Offset(1).Select
Next x
End Sub

Besten Dank für eine Hilfe!
mfg
Erich

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Doppelte markieren / Sigmund Halpern
Klaus-Dieter
Hallo Erich,
hier der geänderte Quelltetx:
Sub Doppelte_Zellen_markieren()
Dim Zelle1
Dim Wo, ber, Ja
eing = InputBox("Die Zelle eingeben, ab der geprüft werden soll," _
& (Chr(13)) & "z.B. A1 oder F6.", "Zellenauswahl")
If eing = "" Then Exit Sub
Range(eing).Select
eing = ""
Application.ScreenUpdating = False
Zelle1 = ActiveCell
Wo = ActiveCell.Address
ActiveCell.Offset(1).Select
ber = ActiveCell.CurrentRegion.Rows.Count
For x = 1 To ber
i = 1
For i = i To ber
If ActiveCell.Interior.ColorIndex = 5 _
Or ActiveCell.Interior.ColorIndex = 8 Then GoTo fin
If ActiveCell.Value = Zelle1 Then
If ActiveCell <> "" Then
ActiveCell.Interior.ColorIndex = 5
ActiveCell.Offset(0, 1) = "Duplikat"
Ja = 1
End If
End If
fin:
ActiveCell.Offset(1).Select
Next i
Range(Wo).Select
If Ja <> 0 Then
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, 1) = "Orginal"
End If
ActiveCell.Offset(1).Select
Wo = ActiveCell.Address
Ja = 0
Zelle1 = ActiveCell
ActiveCell.Offset(1).Select
Next x
End Sub

Gruß Klaus-Dieter

Anzeige
DANKE - Klaus-Dieter!! Super, das wars! o.T.
Erich
AW: Doppelte markieren / Sigmund Halpern
Josef
Hallo Erich!
Bereich auswählen und los geht's!

Sub Doppelte_Zellen_markieren()
Dim rng As Range
Dim Zelle As Range
Dim lngR As Long
Dim lngC As Long
If Selection.Columns.Count > 1 Then Selection.Columns(1).Select
Set rng = Selection
lngR = rng.Rows.Count
For Each Zelle In rng
For lngC = 1 To lngR
With Zelle
If .Value <> "" And .Offset(, 1) <> "Original" And .Offset(, 1) <> "Duplikat" Then
If Zelle = rng(lngC) Then
Zelle.Offset(, 1) = "Duplikat"
rng(lngC).Offset(, 1) = "Original"
End If
End If
End With
Next
Next
End Sub

Gruß Sepp
Anzeige
DANKE - Sepp! Super, Klasse-Variante - o.T.!!
Erich
Erklärungsbedarf
Erich
Hallo Sepp,
hallo EXCEL-Freunde,
habe das Makro auf meine Bedürfnisse angepasst. Da ich über UF eine Tabelle auswähle
und dann unterschiedliche Spalten anspreche, habe ich das mit variablen Spalten gelöst.
In meinem Code wird zuerst eine "Suchspalte" (= letzteSpalte oder MyCol) und dann die
Spalte zum Eintragen ausgewählt (=neueSpalte).
Bei dem ersten Makro spreche ich direkt "neueSpalte" an; bei dem Makro von Sepp
mit "OFFSET" muss ich jetzt aber "neueSpalte - 1" angeben, damit Original/Duplikat
in der Folgespalte eingtragen wird.
Ich bin eigentlich von "neueSpalte + 1" ausgegangen - aber dann bin ich plötzlich zwei
Spalten weiter rechts. Was hat hier offset auf sich bzw. bewirkt dies?
Sub Test()
' mehrfach markieren
iRowL = Cells(Cells.Rows.Count, letzteSpalte).End(xlUp).Row
For iRow = iRowL To 1 Step -1
If WorksheetFunction.CountIf(Columns(letzteSpalte), Cells(iRow, letzteSpalte)) = 1 Then
Cells(iRow, neueSpalte) = "einfach"
End If
If WorksheetFunction.CountIf(Columns(letzteSpalte), Cells(iRow, letzteSpalte)) > 1 Then
Cells(iRow, neueSpalte) = "mehrfach in Spalte " & letzteSpalte
End If
Next iRow

' Aufteilung Original oder Duplikat
' http://www.herber.de/forum/archiv/412to416/t415875.htm
' Josef Ehrensberger
'Dim rng As Range
Dim Zelle As Range, lngR As Long, lngC As Long
Range(Cells(1, MyCol), Cells(myZeile, MyCol)).Select
If Selection.Columns.Count > 1 Then Selection.Columns(1).Select
Set rng = Selection
lngR = rng.Rows.Count
For Each Zelle In rng
For lngC = 1 To lngR
With Zelle
If .Value <> "" And .Offset(, neueSpalte - 1) <> "Original" And .Offset(, neueSpalte - 1) <> "Duplikat" Then
If Zelle = rng(lngC) Then
Zelle.Offset(, neueSpalte - 1) = "Duplikat"
rng(lngC).Offset(, neueSpalte - 1) = "Original"
End If
End If
End With
Next
Next
End Sub


Besten Dank für eine Erklärung!
mfg
Erich
Anzeige
AW: Erklärungsbedarf
Josef
Hallo Erich!
Zum .Offset():
Deine Variable "neueSpalte" ist ja ein nummerischer Wert,
daher verschiebt sich bei dir der Offset, jenachdem welchen
Wert "neueSpalte" besitzt!
Versuch es mal so.
Es werden nurmehr Werte als "Original" bezeichnet,
welche mehrmals vorkommen!(die Duplikate natürlich auch!)
Sub test() Dim Zelle As Range, lngR As Long, lngC As Long Set rng = Range(Cells(1, MyCol), Cells(myZeile, MyCol)) lngR = rng.Rows.Count For Each Zelle In rng For lngC = 1 To lngR With Zelle If .Value <> "" And Left(.Offset(, 1), 1) <> "O" And Left(.Offset(, 1), 1) <> "D" _ And WorksheetFunction.CountIf(rng, rng(lngC)) > 1 Then If Zelle = rng(lngC) Then Zelle.Offset(, 1) = "Duplikat" rng(lngC).Offset(, 1) = "Original" End If End If End With Next Next End Sub
Gruß Sepp
Anzeige
AW: Erklärungsbedarf
Erich
Hallo Sepp,
besten Dank. Muss trotzdem neueSpalte - 1 eintragen; aber soweit kein Problem, da
Dein erster Code ja funktioniert. Bei dieser Variante erhalte ich zudem keinen
Eintrag in den Zeilen, wenn der gesuchte Wert nur einmal vorhanden ist (weil
kein "O" oder "D" zu finden).
Ich bleibe bei dem ersten Code; Deine Erklärung reicht mir soweit!
mfg
Erich
AW: Doppelte markieren - ohne VBA
FP
Hallo Erich,
das kann man aber auch ohne VBA machen ;-)
Tabelle2
 AB
1WertPrüf-Kz
21Original
38Original
42Original
53Original
64Original
72Duplikat
85Original
92Duplikat
106Original
111Duplikat
Formeln der Tabelle
B2 : =WENN(ZÄHLENWENN(A$2:A2;A2)=1;"Original";"Duplikat")
B3 : =WENN(ZÄHLENWENN(A$2:A3;A3)=1;"Original";"Duplikat")
B4 : =WENN(ZÄHLENWENN(A$2:A4;A4)=1;"Original";"Duplikat")
B5 : =WENN(ZÄHLENWENN(A$2:A5;A5)=1;"Original";"Duplikat")
B6 : =WENN(ZÄHLENWENN(A$2:A6;A6)=1;"Original";"Duplikat")
B7 : =WENN(ZÄHLENWENN(A$2:A7;A7)=1;"Original";"Duplikat")
B8 : =WENN(ZÄHLENWENN(A$2:A8;A8)=1;"Original";"Duplikat")
B9 : =WENN(ZÄHLENWENN(A$2:A9;A9)=1;"Original";"Duplikat")
B10 : =WENN(ZÄHLENWENN(A$2:A10;A10)=1;"Original";"Duplikat")
B11 : =WENN(ZÄHLENWENN(A$2:A11;A11)=1;"Original";"Duplikat")
Bedingte Formatierungen der Tabelle
ZelleNr.: / BedingungFormat
A21. / Formel ist =ZÄHLENWENN(A$2:A2;A2)>1Abc
B21. / Zellwert ist gleich ="Duplikat"Abc
A31. / Formel ist =ZÄHLENWENN(A$2:A3;A3)>1Abc
B31. / Zellwert ist gleich ="Duplikat"Abc
A41. / Formel ist =ZÄHLENWENN(A$2:A4;A4)>1Abc
B41. / Zellwert ist gleich ="Duplikat"Abc
A51. / Formel ist =ZÄHLENWENN(A$2:A5;A5)>1Abc
B51. / Zellwert ist gleich ="Duplikat"Abc
A61. / Formel ist =ZÄHLENWENN(A$2:A6;A6)>1Abc
B61. / Zellwert ist gleich ="Duplikat"Abc
A71. / Formel ist =ZÄHLENWENN(A$2:A7;A7)>1Abc
B71. / Zellwert ist gleich ="Duplikat"Abc
A81. / Formel ist =ZÄHLENWENN(A$2:A8;A8)>1Abc
B81. / Zellwert ist gleich ="Duplikat"Abc
A91. / Formel ist =ZÄHLENWENN(A$2:A9;A9)>1Abc
B91. / Zellwert ist gleich ="Duplikat"Abc
A101. / Formel ist =ZÄHLENWENN(A$2:A10;A10)>1Abc
B101. / Zellwert ist gleich ="Duplikat"Abc
A111. / Formel ist =ZÄHLENWENN(A$2:A11;A11)>1Abc
B111. / Zellwert ist gleich ="Duplikat"Abc
 
Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  
Servus aus dem Salzkammergut
Franz
Anzeige
AW: Doppelte markieren - ohne VBA
Erich
Hallo Franz,
besten Dank; bin hier zwingend auf VBA angewiesen, da es Teil einer längeren Prozedur
ist. Die Formel habe ich auch in meiner Sammlung - die Idee mit der Bedingten
Formatierung ist aber Klasse - kann man die bei VBA auch einbauen (siehe Lösung von
Sepp; bei Lösung Klaus-Dieter wird die Originalspalte markiert)?
mfg
Erich

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige