Excel VBA - Vergleichen und am Ende anfügen


jerry0110

Erfahrenes Mitglied
Hallo zusammen,

ich habe 2 Sheets mit Daten.
Und ich möchte den Sheet 1 mit dem Sheet 2 vergleichen.
In der Spalt A Sheet 2 steht ein Wert der in Spalte A Sheet 1 auch stehen könnte.
Wenn der Wert in Sheet 1 steht, dann soll er nichts machen und wenn er das nicht findet, dann soll er das am Ende des Sheets 1 anfügen.

Das habe ich bis jetzt gemacht. Aber wenn ich alles aus Sheet 1 lösche dann fügt er nichts an.

Visual Basic:
Sub suche()

    Dim i As Long
    Dim f As Long
    Dim lastrow As Long
    Dim lastrow2 As Long
 
    lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    lastrow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 4 To lastrow
        For f = 3 To lastrow2
                If Not Worksheets("Sheet1").Range("A" & i).Value = Worksheets("Sheet2").Range("A" & f).Value Then
                    Worksheets("Sheet1").Range("A" & i).Value = Worksheets("Sheet2").Range("A" & f).Value
                    i = i + 1
                End If
        Next
    Next
    
End Sub
 

Zvoni

Erfahrenes Mitglied
Visual Basic:
Sub Suche()
Dim i As Long
Dim j As Long
Dim Treffer As Boolean
Dim lastrow1 As Long
Dim lastrow2 As Long

    lastrow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    For j = 3 To lastrow2
        Treffer = False
        i = 4
        Do
            If Worksheets("Sheet1").Cells(i, 1) = Worksheets("Sheet2").Cells(j, 1) Then
                Treffer = True
                Exit Do
            End If
            i = i + 1
        Loop Until Worksheets("Sheet1").Cells(i, 1) = ""
        If Not Treffer Then
            lastrow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet1").Cells(lastrow1 + 1, 1) = Worksheets("Sheet2").Cells(j, 1)
        End If
    Next

End Sub
 

Anhänge

jerry0110

Erfahrenes Mitglied
Hi,

ich habe zum testen den Code genommen und gestartet.
Natürlich angepasst.

Es läuft durch aber trägt keine Daten ein.
Ich habe zum testen die Daten aus liste 1 gelöscht.
Also müsste er ja alle Daten aus Sheet 2 eintragen.
Macht er aber auch nicht.
 

jerry0110

Erfahrenes Mitglied
Im POP Export Sheet sind alle Daten drin.
Und im Realisierungs Sheet sind die Daten drin wo die Dinge aus der POP Export Liste fehlen könnten.

Visual Basic:
Option Explicit

Sub Suche()
Dim i As Long
Dim j As Long
Dim Treffer As Boolean
Dim lastrow1 As Long
Dim lastrow2 As Long

lastrow2 = Worksheets("POP Export Bestellungen").Cells(Rows.Count, 1).End(xlUp).Row
   
    For j = 3 To lastrow2
        Treffer = False
        i = 4
        Do
            If Worksheets("Realisierung").Cells(i, 1) = Worksheets("POP Export Bestellungen").Cells(j, 1) Then
                Treffer = True
                Exit Do
            End If
            i = i + 1
        Loop Until Worksheets("Realisierung").Cells(i, 1) = ""
        If Not Treffer Then
            lastrow1 = Worksheets("Realisierung").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("POP Export Bestellungen").Cells(j, 1) = Worksheets("Realisierung").Cells(lastrow1 + 1, 1)
        End If
    Next

End Sub