AW: sind beide Tabellen identisch?
16.03.2010 18:05:56
fcs
Hallo Erdogan,
hier mal 2 Varianten.
Function CompareSheets erfasst ggf. auch Bereiche mit Formatierungen, die außerhalb der eigentlichen Daten liegen und kann unterschiedliche Tabellen anzeigen, auch wenn die eigentlichen Daten identisch sind.
Function CompareSheets2 ermittelt in Zeile 1 die die letzte Spalte mit Daten und in Spalte A die letzte Zeile mit Daten und vergleicht dann den sich daraus ergebenden Zellbereich.
Gruß
Franz
Sub Test()
If CompareSheets(wks1:=ActiveWorkbook.Sheets(1), _
wks2:=ActiveWorkbook.Sheets(2)) = True Then
MsgBox "Tabellen sind identisch", vbInformation + vbOKOnly, "Function CompareSheets"
Else
MsgBox "Tabellen sind verschieden", vbInformation + vbOKOnly, "Function CompareSheets"
End If
If CompareSheets2(wks1:=ActiveWorkbook.Sheets(1), _
wks2:=ActiveWorkbook.Sheets(2)) = True Then
MsgBox "Tabellen sind identisch", vbInformation + vbOKOnly, "Function CompareSheets2"
Else
MsgBox "Tabellen sind verschieden", vbInformation + vbOKOnly, "Function CompareSheets2"
End If
End Sub
Function CompareSheets(wks1 As Worksheet, wks2 As Worksheet) As Boolean
Dim Zelle As Range
CompareSheets = True
If wks1.UsedRange.Rows.Count wks2.UsedRange.Rows.Count Or _
wks1.UsedRange.Columns.Count wks2.UsedRange.Columns.Count Then
CompareSheets = False
Else
For Each Zelle In wks1.UsedRange.Cells
If Zelle wks2.Range(Zelle.Address) Then
CompareSheets = False
Exit For
End If
Next
End If
End Function
Function CompareSheets2(wks1 As Worksheet, wks2 As Worksheet) As Boolean
Dim Zelle As Range
Dim Zeilen1 As Long, Spalten1 As Long
Dim Zeilen2 As Long, Spalten2 As Long
CompareSheets2 = True
With wks1
'Zeilen in SPalte A
Zeilen1 = .Cells(.Rows.Count, 1).End(xlUp).Row
'Spalten in Zeile 1
Spalten1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
With wks2
'Zeilen in SPalte A
Zeilen2 = .Cells(.Rows.Count, 1).End(xlUp).Row
'Spalten in Zeile 1
Spalten2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
If Zeilen1 Zeilen2 Or _
Spalten1 Spalten2 Then
CompareSheets2 = False
Else
For Each Zelle In wks1.Range(wks1.Cells(1, 1), wks1.Cells(Zeilen1, Spalten1)).Cells
If Zelle wks2.Range(Zelle.Address) Then
CompareSheets2 = False
Exit For
End If
Next
End If
End Function