VBA Macro
cmad12
plain_text
2 months ago
4.0 kB
4
Indexable
Sub VergleicheSpaltenInZweiDateien() Dim BOM_2025-02-19_MASTER_v2 As String, BOM_2025-02-27_DiffBOM_1 As String Dim spalte As String Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim lastRow1 As Long, lastRow2 As Long Dim i As Long, j As Long Dim gefunden As Boolean Dim ergebnisWs As Worksheet ' Benutzer nach Dateipfaden und Spalte fragen BOM_2025-02-19_MASTER_v2 = Application.GetOpenFilename("Excel-Dateien (*.xlsx), *.xlsx", , "Wähle die erste Excel-Datei") If BOM_2025-02-19_MASTER_v2 = "False" Then Exit Sub BOM_2025-02-27_DiffBOM_1 = Application.GetOpenFilename("Excel-Dateien (*.xlsx), *.xlsx", , "Wähle die zweite Excel-Datei") If BOM_2025-02-27_DiffBOM_1 = "False" Then Exit Sub spalte = InputBox("Gib den Spaltenbuchstaben ein (z.B. A, B, C...)", "Spaltenauswahl") If spalte = "" Then Exit Sub ' Dateien öffnen Set wb1 = Workbooks.Open(BOM_2025-02-19_MASTER_v2) Set wb2 = Workbooks.Open(BOM_2025-02-27_DiffBOM_1) ' Erste Arbeitsblätter in beiden Dateien verwenden Set ws1 = wb1.Worksheets(1) Set ws2 = wb2.Worksheets(1) ' Letzte Zeile in beiden Spalten finden lastRow1 = ws1.Cells(ws1.Rows.Count, spalte).End(xlUp).Row lastRow2 = ws2.Cells(ws2.Rows.Count, spalte).End(xlUp).Row ' Neues Arbeitsblatt für Ergebnisse erstellen Set ergebnisWs = ThisWorkbook.Worksheets.Add ergebnisWs.Name = "Vergleichsergebnis" ' Überschriften erstellen ergebnisWs.Range("A1").Value = "Wert" ergebnisWs.Range("B1").Value = "Status" ergebnisWs.Range("C1").Value = "Quelle" ' Formatierung der Überschriften ergebnisWs.Range("A1:C1").Font.Bold = True Dim ergebnisZeile As Long ergebnisZeile = 2 ' Werte aus Datei 1 prüfen For i = 1 To lastRow1 gefunden = False For j = 1 To lastRow2 If ws1.Range(spalte & i).Value = ws2.Range(spalte & j).Value Then gefunden = True Exit For End If Next j ' Wert in Ergebnisblatt eintragen ergebnisWs.Range("A" & ergebnisZeile).Value = ws1.Range(spalte & i).Value If Not gefunden Then ergebnisWs.Range("B" & ergebnisZeile).Value = "Nur in Datei 1" ergebnisWs.Range("B" & ergebnisZeile).Interior.Color = RGB(255, 200, 200) ' Hellrot Else ergebnisWs.Range("B" & ergebnisZeile).Value = "In beiden Dateien" ergebnisWs.Range("B" & ergebnisZeile).Interior.Color = RGB(200, 255, 200) ' Hellgrün End If ergebnisWs.Range("C" & ergebnisZeile).Value = "Datei 1" ergebnisZeile = ergebnisZeile + 1 Next i ' Werte aus Datei 2 prüfen, die nicht in Datei 1 sind For j = 1 To lastRow2 gefunden = False For i = 1 To lastRow1 If ws2.Range(spalte & j).Value = ws1.Range(spalte & i).Value Then gefunden = True Exit For End If Next i If Not gefunden Then ' Wert in Ergebnisblatt eintragen ergebnisWs.Range("A" & ergebnisZeile).Value = ws2.Range(spalte & j).Value ergebnisWs.Range("B" & ergebnisZeile).Value = "Nur in Datei 2" ergebnisWs.Range("B" & ergebnisZeile).Interior.Color = RGB(255, 255, 200) ' Hellgelb ergebnisWs.Range("C" & ergebnisZeile).Value = "Datei 2" ergebnisZeile = ergebnisZeile + 1 End If Next j ' Spaltenbreite anpassen ergebnisWs.Columns("A:C").AutoFit ' Dateien schließen wb1.Close SaveChanges:=False wb2.Close SaveChanges:=False MsgBox "Vergleich abgeschlossen. Ergebnisse sind im Arbeitsblatt 'Vergleichsergebnis' zu finden.", vbInformation End Sub
Editor is loading...
Leave a Comment