ich finde mein Problem im Code nicht, da ich glaube, dass ich alle Variablen schon vorher definiert habe und trotzdem den Fehler erhalte. Anbei der Code. Der Fehler tritt in Zeile "VergleichsTool2.Worksheets("Datei1").Select" auf. Habt ihr eine Idee?
LG
Michi
Option Explicit
Sub DateiVergleich()
Application.ScreenUpdating = False 'Bildschirmbewegungen des VBA-Codes werden ausgeblendet
Dim ws1Row As Long, ws2Row As Long, ws1Col As Long, ws2Col As Long
Dim maxrow As Long, maxcol As Long
Dim colval1 As String, colval2 As String
Dim Row As Long, Col As Long
Dim diffcnt As Long, report As Workbook, hdr As String
Dim MapColumn() As Long, b As Boolean
Dim reportWS As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim VergleichsTool2 As Workbook
Dim ColNew As Long
Dim ColTitel As String
'Definition der Variablen ist abgeschlossen
Set report = VergleichsTool2
Set ws1 = VergleichsTool2.Worksheets("Datei1")
Set ws2 = VergleichsTool2.Worksheets("Datei2")
'Die verwendeten Zeilen und Spalten der Worksheets werden berechnet
With ws1.UsedRange: ws1Row = .Rows.Count: ws1Col = .Columns.Count: End With
With ws2.UsedRange: ws2Row = .Rows.Count: ws2Col = .Columns.Count: End With
'Die Berechnung der verwendeten Zeile und Spalten der Worksheets ist abgeschlossen
'Die Berechnung der maximalen Zeile und Spalte ist abgeschlossen
maxrow = WorksheetFunction.Max(ws1Row, ws2Row)
maxcol = WorksheetFunction.Max(ws1Col, ws2Col)
'Die maximale Zeile und Spalten aus den beiden Worksheets werden berechnet
'Vorarbeit für korrekte Spaltenzuordnung
ReDim MapColumn(maxcol): For Col = 1 To maxcol: MapColumn(Col) = -1: Next
'Vorarbeit für korrekte Spaltenzuordnung ist abgeschlossen
'
Sub für die korrekte Spaltenzuordnung beginnt
Go
Sub SetColumns
'
Sub für die korrekte Spaltenzuordnung ist abgeschlossen
diffcnt = 0 'Count für Fehler
For Col = 1 To maxcol
For Row = 1 To maxrow
If MapColumn(Col) -1 Then 'If-Bedigung, die kontrolliert, ob der Wert in beiden _
Worksheets vorhanden ist
colval1 = ws1.Cells(Row, Col).Formula
colval2 = ws2.Cells(Row, MapColumn(Col)).Formula
If colval1 colval2 Then 'If-Bedigung, um zu überprüfen, ob es zu Abweichungen in den _
_
Zellen kommt. Wenn das der Fall ist, werden die folgenden Aktionen durchgeführt:
diffcnt = diffcnt + 1 'Anzahl der Fehler steigt um 1
VergleichsTool2.Worksheets("Datei1").Select
Cells(Row, MapColumn(Col)).Interior.Color = 255 'Rote Markierung der Zelle
Cells(Row, MapColumn(Col)).Font.ColorIndex = 1 'Schwarze Markierung des Textes
Cells(Row, MapColumn(Col)).Font.Bold = True 'Fette Markierung des Textes
ColNew = MapColumn(Col)
ColTitel = Cells(1, MapColumn(Col))
Call Fillreport(diffcnt, colval1, colval2, Row, Col, ColNew, ColTitel)
End If ' Überprüfung ist abgeschlossen
End If
Next Row
Next Col
MsgBox diffcnt & " Zellen haben unterschiedliche Werte!"
Call Aggregation
Exit Sub
'
Sub für Spaltenzuordnung beginnt
SetColumns:
'Überprüfung, ob alle Spaltenüberschriften aus ws1 in ws2 vorhanden sind sowie Zuordnung der _
korrekten Spaltenzuordnung zwischen den Arbeitsblättern.
For Col = 1 To ws1Col
hdr = ws1.Cells(1, Col)
For Row = 1 To ws2Col
If ws2.Cells(1, Row) = hdr Then MapColumn(Col) = Row: Exit For
Next
If MapColumn(Col) = -1 Then MsgBox "Spalte " & hdr & " ist nicht vorhanden in " & ws2.Name
Next
'Überprüfung, ob alle Spaltenüberschriften aus ws1 in ws2 vorhanden sind sowie Spaltenzuordnung, _
_
ist abgeschlossen
'Überprüfung, ob alle Spaltenüberschriften aus ws2 in ws1 vorhanden sind sowie Zuordnung der _
korrekten Spaltenzuordnung zwischen den Arbeitsblättern.
For Col = 1 To ws2Col
hdr = ws2.Cells(1, Col)
b = True
For Row = 1 To ws1Col
If ws1.Cells(1, Row) = hdr Then b = False: Exit For
Next
If b Then MsgBox "Spalte " & hdr & " ist nicht vorhanden in " & ws1.Name
Next
'Überprüfung, ob alle Spaltenüberschriften aus ws2 in ws1 vorhanden sind sowie Spaltenzuordnung, _
_
ist abgeschlossen
Return
Application.ScreenUpdating = True 'Die Ausblendung der Bildschirmbewegungen des VBA-Codes wird _
_
wieder aktiviert
End Sub