Jede Zeile mit jeder Zeile vergleichen...
17.05.2018 10:52:44
Max
ich möchte 2 Spalten aus verschiedenen Worksheets miteinander vergleichen und in meine "Ergebnis.xlsm" speichern.
Mit einer geschachtelten Schleife kriege ich es ohne Probleme hin, GLEICHE Werte herauszufinden.
Wenn ich allerdings die UNGLEICHEN Werte will, ist das Ergebnis falsch.
Kurz gesagt, es soll gelten:
ALLE Werte die nur in der Spalte von Sheet 1 vorkommen, aber nicht in der Spalte von Sheet 2, sollen in meine "Ergebnis.xlsm" reinkopiert werden (die gesamte Zeile)
Hier meine Lösung die GLEICHE Werte vergleicht. Wie kann ich nun UNGLEICHE Werte vergleichen und diese einmal in meine Liste Ergebnis Liste einfügen?
Vielen Dank.
PS: Lediglich das = Zeichen mit zu ersetzen funktioniert nicht, da die geschachtelte For Schleife in jede Zeile geht findet er alle Werte als ungleich.
Option Explicit
Sub Test()
Dim xlApp As Object ' Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Dim xlApp2 As Object ' Excel.Application
Dim xlBook2 As Object 'Excel.Workbook
Dim xlSheet2 As Object 'Excel.Worksheet
'------------------------------------------------------------------------------------------- _
'------------------------------------------------------------------------------------------- _
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
End If
Set xlBook = xlApp.Workbooks.Open("C:\Desktop\TestListe.xlsx")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.EnableAutoFilter = False
'------------------------------------------------------------------------------------------- _
Set xlApp2 = GetObject(, "Excel.Application")
If xlApp2 Is Nothing Then
Set xlApp2 = CreateObject("Excel.Application")
End If
Set xlBook2 = xlApp2.Workbooks.Open("C:\Desktop\ZweiteTestListe.xlsx")
Set xlSheet2 = xlBook2.Worksheets(1)
xlSheet2.EnableAutoFilter = False
'------------------------------------------------------------------------------------------- _
'------------------------------------------------------------------------------------------- _
Dim letzteZeile As Long
letzteZeile = xlSheet.Cells(Rows.Count, 1).End(xlUp).row
Dim letzteZeile2 As Long
letzteZeile2 = xlSheet2.Cells(Rows.Count, 2).End(xlUp).row
Dim y, a As Integer
For y = 1 To letzteZeile
For a = 1 To letzteZeile2
If xlSheet.Cells(y, 1).Value = xlSheet2.Cells(a, 2).Value Then
Dim letzte As Long
letzte = Workbooks("Ergebnis.xlsm").Worksheets(1).Cells(Rows.Count, 1).End(xlUp) _
.row
letzte = letzte + 1
Application.WindowState = xlNormal
xlSheet.Rows(y).Copy
With Workbooks("Ergebnis.xlsm").Worksheets(1).Rows(letzte & ":" & letzte)
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
End With
End If
Next
Next
End Sub