![]() |
Betrifft: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 29.09.2014 15:10:58
Hallo
ich habe eine excel-Datei, in der 2 identisch aufgebaute Tabellen auf 2 Blättern vorkommen.
Ich möchte gerne diese beiden Tabellen vergleichen und unterschiede in der 2. Tabelle rot markieren.
das problem dabei: es können in der 2. Tabelle neue zeilen hinzugekommen sein. diese müsste dann komplett rot markiert werden.
Zur veranschauung habe ich mal ein beispiel hochgeladen.
https://www.herber.de/bbs/user/92878.xlsx
Hätte hier jmd eine gute idee??
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: KlausF
Geschrieben am: 29.09.2014 16:52:41
Hallo Artanan,
probier mal:
Sub Finden() Dim myString As Variant Dim myColor As Integer Dim a As Integer Dim i As Long Dim findRow As Long Dim lastRow As Long Dim lastCol As String Dim findRng As Range Dim wksSource As Worksheet Dim wksZiel As Worksheet Set wksSource = Worksheets("Extrakt1") Set wksZiel = Worksheets("Extrakt2") myColor = 3 lastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1) For i = 2 To lastRow myString = wksZiel.Range("B" & i).Value Set findRng = wksSource.Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Find(What:= _ myString, Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True) If Not findRng Is Nothing Then findRow = findRng.Row For a = 1 To ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column If wksZiel.Cells(i, a).Value <> wksSource.Cells(findRow, a).Value Then wksZiel.Cells(i, a).Interior.ColorIndex = myColor End If Next a Else wksZiel.Range("A" & i & ":" & lastCol & i).Interior.ColorIndex = myColor End If Next i Set wksZiel = Nothing Set wksSource = Nothing Set findRng = Nothing End Sub
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 29.09.2014 17:31:06
boah das klappt schon fast.
allerdings habe ich es gerade auf die originaltabelle angewandt und da markiert es zu viel (auch zellen die gleich geblieben sind)
ich habe im code nur die namen der tabellenblätter (extrakt 1 und 2) angepasst.
ansonsten ist der code ja nicht abhängig davon, was in der spaltenüberschrift steht oder?
ich glaube es liegt daran, dass ab und zu manche zellen leer sind. das verträgt sich bestimmt nicht mit der rows.count methode oder?
falls ja, könntest du das anpassen? die spalte A und die Zeile 2 enthalten auf jeden fall keine leeren zellen.
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 29.09.2014 17:49:04
https://www.herber.de/bbs/user/92881.xlsm
hier habe ich nochmal ein beispiel. die blätter sind exakt gleich aber es wird trotzdem markiert...
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: KlausF
Geschrieben am: 29.09.2014 18:24:47
Hallo Artanan,
habe jetzt erst Deine neue Datei gesehen (Posts haben sich überschnitten).
Die Daten haben nichts mit Deiner ersten Datei gemein. In der ersten Datei
waren die Daten der Spalte B unterschiedlich und dienten für mich als Referenzpunkt
zur Untersuchung der Spalten (irgendetwas muss ja verglichen werden).
Gruß
Klaus
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 30.09.2014 09:42:21
sry war gestern abend nicht mehr am pc!
Aaah okay jetzt verstehe ich.
Leider kommt es ab und zu vor, dass die daten in spalte b identisch sind (also innerhalb des gleichen blattes die gleiche nummer in der spalte steht).
Brauche ich also eine spalte, in der keine duplikate vorkommen für deine methode?
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 30.09.2014 10:30:51
tut mir leid, dass es so umständlich ist. leider gibt es im original keine spalte, die immer unterschiedliche daten enthält. gibt es eine möglichkeit zu sagen, man überprüft die kombination der spalten b, c und d?
diese 3 spalten zusammen (in kombination) sind nämlich immer verschieden.
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: KlausF
Geschrieben am: 30.09.2014 17:00:45
Hallo Artanan,
dein letzter post kam zu spät. Hier eine Lösung für die Kombination b, c und d.
Sub Finden() Dim myString As Variant Dim myColor As Integer Dim a As Integer Dim i As Long Dim findRow As Long Dim lastRow As Long Dim lastCol As String Dim findRng As Range Dim wksSource As Worksheet Dim wksZiel As Worksheet Set wksSource = Worksheets("Extrakt1") Set wksZiel = Worksheets("Extrakt2") myColor = 3 lastRow = wksZiel.Cells(Rows.Count, 2).End(xlUp).Row lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1) With wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row) .FormulaR1C1 = "=RC[-254]&RC[-253]&RC[-252]" .Value = .Value End With For i = 3 To lastRow myString = wksZiel.Range("B" & i).Value & wksZiel.Range("C" & i).Value & wksZiel.Range("D" & _ i).Value Set findRng = wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row).Find(What:= _ myString, Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True) If Not findRng Is Nothing Then findRow = findRng.Row For a = 1 To ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column If wksZiel.Cells(i, a).Value <> wksSource.Cells(findRow, a).Value Then wksZiel.Cells(i, a).Interior.ColorIndex = myColor End If Next a Else wksZiel.Range("A" & i & ":" & lastCol & i).Interior.ColorIndex = myColor End If Next i wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents Set wksZiel = Nothing Set wksSource = Nothing Set findRng = Nothing End Sub
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 30.09.2014 17:37:34
Unglaublich...vielen vielen dank. Ich werde es gleich morgen testen.
Nur damit ich gut schlafen und was lernen kann ;) diese änderung vom ursprünglichen code von spalte b auf spalte a habe ich einfach nicht hinbekommen. (Siehe letzter post).
Siehst du den fehler vll auf anhieb?
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 01.10.2014 11:00:58
Also der Kombinations-code funktioniert einwandfrei. Herzlichen Dank für deine Hilfe. :)
![]() ![]() |
Betrifft: Danke für die Rückmeldung
von: KlausF
Geschrieben am: 01.10.2014 13:47:39
Danke für die Rückmeldung
Gruß
Klaus
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: Artanan
Geschrieben am: 30.09.2014 16:00:42
ok habe jetzt eine lösung. in der spalte a ist bei mir jetzt einfach eine fortlaufende nummer von 1 bis x. damit müsste es funktionieren.
allerdings habe ich es nicht hinbekommen deinen code so umzuändern, dass nicht spalte b sondern spalte a als referenz dient :|
Sub Finden() Dim myString As Variant Dim myColor As Integer Dim a As Integer Dim i As Long Dim findRow As Long Dim lastRow As Long Dim lastCol As String Dim findRng As Range Dim wksSource As Worksheet Dim wksZiel As Worksheet Set wksSource = Worksheets("Extrakt1") Set wksZiel = Worksheets("Extrakt2") myColor = 3 lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1) For i = 2 To lastRow myString = wksZiel.Range("a" & i).Value Set findRng = wksSource.Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row).Find(What:= _ _ myString, Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True) If Not findRng Is Nothing Then findRow = findRng.Row For a = 1 To ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column If wksZiel.Cells(i, a).Value <> wksSource.Cells(findRow, a).Value Then wksZiel.Cells(i, a).Interior.ColorIndex = myColor End If Next a Else wksZiel.Range("A" & i & ":" & lastCol & i).Interior.ColorIndex = myColor End If Next i Set wksZiel = Nothing Set wksSource = Nothing Set findRng = Nothing End Subhab ich da noch einen fehler?
![]() ![]() |
Betrifft: AW: 2 Tabellenblätter vergleichen
von: KlausF
Geschrieben am: 29.09.2014 18:12:59
Hallo Artanan,
hmm, so ganz genau weiß ich nicht, was Du meinst.
Probier mal
Sub Finden() Dim myString As Variant Dim myColor As Integer Dim a As Integer Dim i As Long Dim findRow As Long Dim lastRow As Long Dim lastCol As String Dim findRng As Range Dim wksSource As Worksheet Dim wksZiel As Worksheet Set wksSource = Worksheets("Extrakt1") Set wksZiel = Worksheets("Extrakt2") myColor = 3 lastRow = wksZiel.Cells(Rows.Count, 1).End(xlUp).Row lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1) For i = 2 To lastRow myString = wksZiel.Range("B" & i).Value If myString = "" Then GoTo LEER Set findRng = wksSource.Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Find(What:= _ myString, Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True) If Not findRng Is Nothing Then findRow = findRng.Row For a = 1 To wksZiel.Cells(2, Columns.Count).End(xlToLeft).Column If wksZiel.Cells(i, a).Value <> wksSource.Cells(findRow, a).Value Then wksZiel.Cells(i, a).Interior.ColorIndex = myColor End If Next a Else wksZiel.Range("A" & i & ":" & lastCol & i).Interior.ColorIndex = myColor End If LEER: Next i Set wksZiel = Nothing Set wksSource = Nothing Set findRng = Nothing End SubWenn es immer noch kneift, dann ändere mal die Daten so, dass der Fehler auftritt
![]() |