Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1704to1708
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
Inhaltsverzeichnis

doppelte Ausdrücke über 2 Blätter markieren

doppelte Ausdrücke über 2 Blätter markieren
12.08.2019 09:48:10
Jens
HAllo,
weis jemand wie man über VBA doppelte Ausdrücke über zwei Blätter hinweg vergleicht und dann die Zellen rot einfärbt?
Irgendwie weis ich garnicht wie ich das machen soll.
https://www.herber.de/bbs/user/131389.xlsx

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: warum nicht nur bed. Formatierung ? owT
12.08.2019 09:53:48
neopa
Gruß Werner
.. , - ...
AW: warum nicht nur bed. Formatierung ? owT
12.08.2019 11:06:03
Jens
VBA? wäre da deutlich besser hinsichtlich meiner Anwendung.
AW: doppelte Ausdrücke über 2 Blätter markieren
12.08.2019 11:34:45
fcs
Hallo Jens,
der Weg über Hilfsspalten und Formeln + bedingte Formatierung geht eigentlich schneller.
1. Hilfsspalte (hier Spalte H) in beiden Blättern: Formel in Zeile 11 generiert die eindeutige ID aus den 6 Spalten
=B11&"|"&C11&"|"&D11&"|"&E11&"|"&F11&"|"&G11

2. Hilfsspalte sucht die ID in der jeweils anderen Tabelle.
=ISTZAHL(VERGLEICH(H11;Tabelle1!H:H;0))

Die Formeln in den beiden Hilfsspalten nach unten kopieren
Wenn die ID in der anderen Tabelle vorhanden ist, dann liefert die Formel in der 2. Hilfsspalte als Ergebnis WAHR.
Dieses Ergebnis kann man in einer bedingten Formatierung verarbeiten.
Makro-Lösung kann wie folgt aussehen.
LG
Franz
Sub TabVergleich()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim zei_1 As Long, Zei_2 As Long, Zeile As Long, Spalte As Long
Dim arrID1() As String, arrID2() As String
Const sSep As String = "|"
Set wks1 = ActiveWorkbook.Worksheets("Tabelle1")
Set wks2 = ActiveWorkbook.Worksheets("Tabelle2")
'IDs in Tabelle 1 zusammenfügen und in Array speichern
With wks1
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
ReDim arrID1(zei_1 To Zei_2)
For Zeile = zei_1 To Zei_2
For Spalte = 2 To 7
arrID1(Zeile) = arrID1(Zeile) & sSep & .Cells(Zeile, Spalte).Text
Next
Next
End With
'IDs in Tabelle 2 zusammenfügen und in Array speichern
With wks2
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
ReDim arrID2(zei_1 To Zei_2)
For Zeile = zei_1 To Zei_2
For Spalte = 2 To 7
arrID2(Zeile) = arrID2(Zeile) & sSep & .Cells(Zeile, Spalte).Text
Next
Next
End With
'IDs aus Tabelle 1 in IDs der Tabelle 2 suchen und Zeilen markieren wenn in 2 vorhanden
With wks1
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
For Zeile = zei_1 To Zei_2
If IsNumeric(Application.Match(arrID1(Zeile), arrID2, 0)) Then
.Range(.Cells(Zeile, 2), .Cells(Zeile, 6)).Interior.ColorIndex = 3
End If
Next
End With
'IDs aus Tabelle 2 in IDs der Tabelle 1 suchen und Zeilen markieren wenn in 1 vorhanden
With wks2
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
For Zeile = zei_1 To Zei_2
If IsNumeric(Application.Match(arrID2(Zeile), arrID1, 0)) Then
.Range(.Cells(Zeile, 2), .Cells(Zeile, 6)).Interior.ColorIndex = 3
End If
Next
End With
End Sub

Anzeige
AW: doppelte Ausdrücke über 2 Blätter markieren
12.08.2019 11:37:52
Daniel
HI
per VBA so:
Sub doppelteFinden()
Dim b As Long
Dim TB
Dim z As Long
Dim id As String
Dim dic
Dim WF As Object
Set WF = WorksheetFunction
Const ZeileAb As Long = 11
Set dic = CreateObject("scripting.dictionary")
TB = Array("Tabelle1", "Tabelle2")
'--- Doppelte finden
For b = 0 To UBound(TB)
With Sheets(TB(b))
For z = ZeileAb To .Cells(.Rows.Count, 2).End(xlUp).Row
id = Join(WF.Transpose(WF.Transpose(.Cells(z, 2).Resize(, 6))), "|")
If dic(id) 
der Code ist so geschrieben, dass du damit nicht nur 2 sondern auch mehrere Tabellenblätter auf Duplikate in allen Blättern überprüfen kannst, einfach indem du den Blattnamen im Array TB hinzufügst.
Das Makro findet keine Duplikate innerhalb des selben Blattes. Dh wenn eine Zeile im selben Blatt mehrfach vorkommt, wird es trotzdem nur 1x gewertet.
Gruß Daniel
Anzeige
AW: doppelte Ausdrücke über 2 Blätter markieren
12.08.2019 12:01:25
Jens
Besten Dank an euch beiden.
@Daniel.
Kann man es noch so machen, dass auch gleiche werte auf den selben Blättern gefunden werden?
was das wäre schon grundsätzlich möglich.
AW: doppelte Ausdrücke über 2 Blätter markieren
12.08.2019 12:14:42
Daniel
Hi
wenn es dir egal ist, wo sich das Duplikat befindet, dann macht das die Sache natürlich einfacher:
ersetze im Bereich "--- Doppelte finden"
If dic(id) durch
dic(id) = dic(id) + 1
und im Bereich "--- Doppelte markieren"
If dic(id) = 2 ^ (UBound(TB) + 1) - 1 Then
durch
If dic(id) > 1 Then
Gruß Daniel
AW: doppelte Ausdrücke über 2 Blätter markieren
12.08.2019 12:38:01
jens
danke.
perfekt.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige