Microsoft Excel

Herbers Excel/VBA-Archiv

2 Tabellenblätter vergleichen

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

Gruß
Klaus


  

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

Gruß
Klaus


  

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 Sub



hab 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 Sub
Wenn es immer noch kneift, dann ändere mal die Daten so, dass der Fehler auftritt
und poste die neue Datei. Mit den vorhandenen Daten läuft es bei mir fehlerfrei.

Und was willst Du im Code angepasst haben?
Ich habe doch Deine Tabellenblatt-Namen übernommen ...

Gruß
Klaus


 

Beiträge aus den Excel-Beispielen zum Thema "2 Tabellenblätter vergleichen"