Hallo zusammen,
ich möchte einen SVerweis in meine Formel einbauen, und bin mir unschlüssig, wie ich das machen soll. Hintergrund ist, dass bereits eine flexible Auswahl der Spalte (zIr Lösung von Problemen wie: in Datei1 ist Überschrift1 in Spalte 4 und in Datei2 ist Überschrift 1 in Spalte 8) eingebaut ist und ich zurzeit in der Programmierung erfolglos bin, dieses für die Zeilen zu übernehmen - hier wäre der Primärschlüssel bzw. die Idee in Spalte 1.
Über Ideen wie ich das anstellen kann? Anbei der Code:
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
Dim Zähler1 As Long
'Definition der Variablen ist abgeschlossen
Set VergleichsTool2 = ActiveWorkbook
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
GoSub 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(2).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 = Worksheets("Datei2").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
LG
Darius