Spalteninhalte vergleichen über zwei Tabellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Constantin,
ungetestet.

' **********************************************************************
' Modul: Modul5 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub vergleich()
  Dim objSh_1 As Worksheet, objSh_2 As Worksheet
  Dim vntRet As Variant, lngCol As Long, lngRow As Long, lngLast As Long

  On Error GoTo ErrExit
  Application.ScreenUpdating = False

  Set objSh_1 = Sheets("Tabelle1") 'Name der ersten Tabelle- Anpassen!
  Set objSh_2 = Sheets("Tabelle2") 'Name der zweiten Tabelle- Anpassen!

  With objSh_1
    'Zellfarben löschen
    .UsedRange.Interior.ColorIndex = xlNone
    'Letzte Datenzeile in "Tabelle1" ermitteln
    lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)

    'Zeilen durchlaufen
    For lngRow = 2 To lngLast
      'Fortschrittsmeldung in der Statuszeile
      Application.StatusBar = "Vergleiche Datensatz " & CStr(lngRow - 1) & " von " _
        & CStr(lngLast - 1) & " --- Bitte warten ---"
      'ID in "Tabelle2" suchen
      vntRet = Application.Match(.Cells(lngRow, 3), objSh_2.Columns(3), 0)

      'ID gefunden
      If IsNumeric(vntRet) Then
        'Spalten durchlaufen
        For lngCol = 4 To 40
          'Bei Unterschied markieren
          If .Cells(lngRow, lngCol) <> objSh_2.Cells(vntRet, lngCol) Then
            .Cells(lngRow, lngCol).Interior.ColorIndex = 6
          End If
        Next
      End If
    Next
  End With

  ErrExit:
  Application.ScreenUpdating = True
  Application.StatusBar = False
  Set objSh_1 = Nothing
  Set objSh_2 = Nothing
End Sub

Gruß Sepp

Hallo Sepp oder wer es wissen könnte,
darf ich hier doch noch eine Nachfrage stellen? Wenn ich nun noch einbauen möchte, dass beim Vergleich beider Tabellen bzw. deren Spalteninhalte (im Falle von Unterschied) neben der farblichen Markierung noch ein Kommentarfeld in der gleichen Zelle von Tabelle1 erzeugt wird und dort der Vergleichswert von Tabelle2 eingetragen werden soll - wie müsste das Programm abgeändert werden?
Da beim Vergleich beider Tabellen es noch sein kann, dass Tabelle2 Sätze enthält, die in Tabelle1 nicht vorkommen, habe ich noch nachstehende kleine Programmergänzung vorgenommen ('Constantin).
Die Zeilen, die in Tabelle2 kein "X" bekommen haben, sollten nun noch an Tabelle1 angehängt und rot markiert werden.
Gruß, Constantin
und vielen Dank für eure Unterstützung.
'ID gefunden
If IsNumeric(vntRet) Then
'Spalten durchlaufen
For lngCol = 4 To 40
'Bei Unterschied markieren
If .Cells(lngRow, lngCol) objSh_2.Cells(vntRet, lngCol) Then
.Cells(lngRow, lngCol).Interior.ColorIndex = 6
.Cells(lngRow, 41).Value = "Änderung" 'Constantin
End If
Next
objSh_2.Cells(vntRet, 41).Value = "X" ' Constantin
End If

Beliebteste Forumthreads (12 Monate)

Spalteninhalte vergleichen über zwei Tabellen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalteninhalte vergleichen über zwei Tabellen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread