Office: Listen vergleichen

Hallo,
ich brauche mal wieder eure Hilfe.
Ich will zwei Listen mit einander vergleichen und die Positionen aus Liste A, die in Liste B nicht vorhanden sind, an diese anhängen.
Mit folgendem Code erkenne ich die erste leere Zelle und kann die Daten dort einfügen.
Private Sub CommandButton1_Click()
Sheets("22").Range("A1:A500").Copy
Dim Ende As Integer
Ende = UsedRange.Rows.Count
Rows(Ende).Select
Cells(Ende + 1, 2).Select
Sheets("22").Range(ActiveCell.Address).PasteSpecial Paste:=xlValues
End Sub
Wie bekomme ich es hin, dass nur die Zellen kopiert werden, die nicht schon in B vorhanden sind? Bei dem Code werden alle Zellen aus dem Bereich angehängt.
Liste A muss dabei erhalten bleiben.
danke im Voraus für eure Bemühungen.
P.S.: ich habe in diesem und anderen Foren schon einiges geffunden, bekomme es aber nicht auf mein problem angepasst.

 

Hallo,

folgendes VBA-Makro müsste das erledigen. Dabei muss der Button CommandButton1 in dem Blatt sich befinden, in das kopiert wird (Zielblatt). Beide Bereiche dürfen mehrere Spalten besitzen, jedoch aber gleich viele. Miteinander vergleichen werden jedoch nur die Zellen der jeweils 1. Spalte beider Bereiche.

Code:

Private Sub CommandButton1_Click()
  Dim Quelle As Range, Ziel As Range
  Dim Zelle As Range, FundZelle As Range
  Dim ZielLztZeile As Long, QuellSpalten As Long
  
  Set Quelle = Worksheets("22").Range("A1:A500")
  Set Ziel = ActiveSheet.UsedRange.Columns(1)
  QuellSpalten = Quelle.Columns.Count 'Falls Quelle doch mehr als 1 Spalte besitzt
  
  For Each Zelle In Quelle.Columns(1).Cells
    Set FundZelle = Ziel.Columns(1).Find(What:=Zelle.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If FundZelle Is Nothing Then
      'Zellwert der Quelltabelle wurde in der Zieltabelle nicht gefunden
      'Anfügen am Ende von Ziel und Ziel vergrößern
      Zelle.Resize(, QuellSpalten).Copy
      ZielLztZeile = Ziel.Rows.Count + 1
      Set Ziel = Ziel.Resize(ZielLztZeile)
      Ziel.Rows(ZielLztZeile).PasteSpecial Paste:=xlValues
    Else
      'Zelle wurde in der Zieltabelle gefunden - kein Kopieren
    End If
  Next Zelle
End Sub

 

Besten Dank.
Genau das was ich gesucht habe.
Ihr seid hier wirklich alle ganz große Klasse :-D

Könnte man das jetzt noch erweitern, so dass die ersten drei Spalten abgefragt werden?
z.B.:
Spalte A = Artikel, Spalte B = Preis, Spalte D = Händler.

der Artikel soll auch dann angefügt werden, wenn er existiert, sich der Preis aber geändert hat oder er von einem anderen Händler ebenfalls angeboten wird.

Währe super.

 

Hallo Thorbln,

hier das Makro:

Code:

'Könnte man das jetzt noch erweitern, so dass die ersten drei Spalten abgefragt werden?
'z.B.:
'Spalte A = Artikel, Spalte B = Preis, Spalte D = Händler.
'der Artikel soll auch dann angefügt werden, wenn er existiert,
'sich der Preis aber geändert hat oder er von einem anderen Händler ebenfalls angeboten wird.
'
Private Sub CommandButton1_Click()
  Dim Quelle As Range, Ziel As Range
  Dim QuZelle As Range, ZlZelle As Range, ZlErstAdr$, ZlExistKombi As Boolean
  Dim QuPreis As Range, QuHändler As Range
  Dim ZielLztZeile As Long, QuellSpalten As Long
  
  Set Quelle = Worksheets("22").Range("A1").CurrentRegion
  Set Ziel = ActiveSheet.UsedRange.Columns(1)
  QuellSpalten = Quelle.Columns.Count 'Spaltenanzahl der Quelltabelle
  
  For Each QuZelle In Quelle.Columns(1).Cells
    Set ZlZelle = Ziel.Find(What:=QuZelle.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If ZlZelle Is Nothing Then
      'Artikel der Quelltabelle wurde in der Zieltabelle nicht gefunden:
      'Unbedingtes Anfügen am Ende von Ziel und Ziel vergrößern
      ZlExistKombi = False
    Else
      'Artikel der Quelltabelle wurde in der Zieltabelle gefunden:
      'Überprüfen, ob Preis bzw. Händler der Quelltabelle ebenfalls schon in der Zieltabelle vorhanden sind
      ZlErstAdr$ = ZlZelle.Address
      Do
        ZlExistKombi = IstExistArtikelKombi(QuZelle, ZlZelle)
        'Falls Kombi aus Artikel/Preis/Händler bereits existiert in Zieltabelle -> Abbruch der Suche
        If ZlExistKombi Then Exit Do
        'Überprüfen, ob der Artikel noch ein weiteres Mal existiert
        Set ZlZelle = Ziel.FindNext(After:=ZlZelle)
        'Abbruch, falls ganze Zieltabelle durchsucht wurde und keine Kombi gefunden wurde
      Loop While ZlZelle.Address <> ZlErstAdr$
      
    End If
    
    If Not ZlExistKombi Then
      'Kombination aus Artikel/Preis/Händler der Quelltabelle existiert nicht in der Zieltabelle:
      'Vergrößern 1.Quellspalte auf Quelltabellenbreite; Kopieren der Quelltabellenzeile
      QuZelle.Resize(, QuellSpalten).Copy
      'Vergrößern der Zieltabelle um 1 Zeile
      ZielLztZeile = Ziel.Rows.Count + 1
      Set Ziel = Ziel.Resize(ZielLztZeile)
      'Einfügen der Zwischenablagewerte in letzte Zieltabellenzeile
      Ziel.Rows(ZielLztZeile).PasteSpecial Paste:=xlValues
    End If
  Next QuZelle
  Application.CutCopyMode = False
End Sub
Private Function IstExistArtikelKombi(Qu As Range, Zl As Range) As Boolean
  IstExistArtikelKombi = False
  'Überprüfe, ob die Preise von Quelle und Ziel gleich sind:
  If Qu.Offset(0, 1).Value <> Zl.Offset(0, 1).Value Then Exit Function
  'Überprüfe, ob die Händler von Quelle und Ziel gleich sind:
  If Qu.Offset(0, 3).Value <> Zl.Offset(0, 3).Value Then Exit Function
  'Preise und Händler stimmen überein
  IstExistArtikelKombi = True
End Function

Auf eine kleine Diskrepanz möchte ich aufmerksam machen, falls sie von Bedeutung sein sollte: Du sprichst einerseits von den ersten 3 Spalten, andererseits befindet sich der Händler in Spalte D.
Mein Makro sucht den Artikel in Spalte A, den Preis in Spalte B und den Händler in Spalte D in beiden Tabellen. Falls dem nicht so sein sollte, musst Du in der FUNCTION IstExistArtikelKombi die (beiden) Offsets Qu.Offset(0,3) bzw. Zl.Offset(0,3) entsprechend anpassen (=>..Offset(0,2) ).

 

Sorry,
da habe ich wohl etwas geschlafen. Der Händler ist in Spalte C. Die Anpassung hat einwandfrei funktioniert.
Noch ein Kleiner Schönheitsfehler:
Zeilen 1 und 2 der Quellliste sind Eingabefelder und Informationen.
Es währe schön, wenn die Suche erst in Zeile Drei der Quellliste beginnen würde. Allerdings hat eine Änderung der Zeile
Set Quelle = Worksheets("22").Range("A1").CurrentRegion
in
Set Quelle = Worksheets("22").Range("A3").CurrentRegion
keine Wirkung gezeigt.
Was muss ich ändern damit erst ab Zeile 3 gesucht wird?

 

Hallo Torbln,

das ist für mich klar, dass Du keine Änderung im Makroverhalten erreicht hast mit der Zellverlegung von A1 nach A3, denn die 1.Zeile das nachfolgenden Codes macht Folgendes:
Der Code in der 1.Zeile des folgenden Codeausschnittes geht im Arbeitsblatt "22" in die Zelle A3 und die Eigenschaft CurrentRegion sucht, von dort ausgehend, nach dem kleinsten Rechteckbereich, der nur von Leerzellen (bzw. vom Arbeitsblattrand) umgeben ist.
Da Du sagst, dass in Zeile 1+2 im Bereich der Listenspalten etwas enthalten ist, werden auch diese Zellen miteinbezogen in den Bereich "Quelle" und deshalb ist dieser "Quelle"-Bereich genauso groß wie wenn es ...Range("A1").CurrentRegion hieße.

Die 2.Zeile im folgenden Codeausschnitt habe ich jetzt neu eingefügt, um die beiden ersten Zeilen aus dem Bereich "Quelle" zu exkludieren: Dieser Code verschiebt den in der vorherigen Zeile ermittelten "Quelle"-Bereich um 2 Zeilen nach unten (Quelle.Offset(2,0)) und anschließend muss der Bereich noch um 2 Zeilen kleiner gemacht werden (.Resize(Quelle.Rows.Count-2)).

Code:

  Set Quelle = Worksheets("22").Range("A3").CurrentRegion
  Set Quelle = Quelle.Offset(2, 0).Resize(Quelle.Rows.Count - 2)
  Set Ziel = ActiveSheet.UsedRange.Columns(1)
  QuellSpalten = Quelle.Columns.Count 'Spaltenanzahl der Quelltabelle

Anmerkung:
Zur Ermittlung des Bereiches "Ziel" wird in Zeile 3 des vorherigen Codeausschnittes die Eigenschaft UsedRange verwendet. Der Unterschied zu CurrentRegion ist, dass diese Eigenschaft im betreffenden Arbeitsblatt den kleinsten Rechteckbereich ermittelt, der Daten enthält; außerhalb dieses Bereiches gibt es folglich nur Leerzellen.
Bei CurrentRegion kann es sehr wohl außerhalb des Bereiches auch noch Daten im Arbeitsblatt geben; sie müssen nur durch mindestens 1 Leerzeile/Leerspalte vom CurrentRegion-Bereich getrennt sein.

 

Hallo Exl121150
erst einmal vielen Dank für deine rasche Antwort, vor allem für die ausführlichen Erklärungen dazu.
Ich habe den neuen Code eingefügt. Die erste Zeile wird nun ignoriert, die zweite aber immer noch mit kopiert.
Woran könnte das jetzt liegen?
Ich hänge mal eine Beispieldatei an. Vielleicht ist es so leichter das Problem zu erkennen.

 

Hallo,

ich habe das Makro Deiner Arbeitsmappe überprüft und konnte nur feststellen, dass der Quellbereich (Arbeitsblatt "bearbeiten") erst ab Zelle A3 (also ab der 3. Zeile im Blatt) für das Artikelkopieren herangezogen wird. Allerdings umfasst dieser "Quell"-bereich A3:D52, weil ab Zeile 30 in den Spalten C+D auch noch Einträge vorhanden sind. Da dies lauter identische Einträge sind (Spalte A = leere Artikelbez., Spalte B = leerer Preis, Spalte C = Lieferant Aldi) wird im Zielblatt "Artikelliste" nur 1 Artikel mit leerer Artikelbezeichnung ganz am Schluss angefügt.

Ich habe jetzt eine Zusatzabfrage für die Quelltabelle eingefügt, dass Artikeln mit leerer Artikelbezeichnung (Spalte A) nicht mehr kopiert werden.
Ferner habe ich auch für den Zielbereich (Arbeitsblatt "Artikelliste") die Bereichsverschiebung (Zielbereich erst ab Zeile 3) eingefügt, obwohl dort in der Regel ja nichts passieren kann, weil alle Artikel an bereits vorhandene angefügt werden.

Code:

Private Sub CommandButton1_Click()
  Dim Quelle As Range, Ziel As Range
  Dim QuZelle As Range, ZlZelle As Range, ZlErstAdr$, ZlExistKombi As Boolean
  Dim QuPreis As Range, QuHändler As Range
  Dim ZielLztZeile As Long, QuellSpalten As Long
 
  Set Quelle = Worksheets("bearbeiten").Range("A3").CurrentRegion
  Set Quelle = Quelle.Offset(2, 0).Resize(Quelle.Rows.Count - 2)
  Set Ziel = ActiveSheet.UsedRange.Columns(1)
  Set Ziel = Ziel.Offset(2, 0).Resize(Ziel.Rows.Count - 2)
  QuellSpalten = Quelle.Columns.Count 'Spaltenanzahl der Quelltabelle
 
  For Each QuZelle In Quelle.Columns(1).Cells
    If QuZelle.Value = "" Then GoTo Nxt_QuellArtikel
    Set ZlZelle = Ziel.Find(What:=QuZelle.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If ZlZelle Is Nothing Then
      'Artikel der Quelltabelle wurde in der Zieltabelle nicht gefunden:
      'Unbedingtes Anfügen am Ende von Ziel und Ziel vergrößern
      ZlExistKombi = False
    Else
      'Artikel der Quelltabelle wurde in der Zieltabelle gefunden:
      'Überprüfen, ob Preis bzw. Händler der Quelltabelle ebenfalls schon in der Zieltabelle vorhanden sind
      ZlErstAdr$ = ZlZelle.Address
      Do
        ZlExistKombi = IstExistArtikelKombi(QuZelle, ZlZelle)
        'Falls Kombi aus Artikel/Preis/Händler bereits existiert in Zieltabelle -> Abbruch der Suche
        If ZlExistKombi Then Exit Do
        'Überprüfen, ob der Artikel noch ein weiteres Mal existiert
        Set ZlZelle = Ziel.FindNext(After:=ZlZelle)
        'Abbruch, falls ganze Zieltabelle durchsucht wurde und keine Kombi gefunden wurde
      Loop While ZlZelle.Address <> ZlErstAdr$
     
    End If
   
    If Not ZlExistKombi Then
      'Kombination aus Artikel/Preis/Händler der Quelltabelle existiert nicht in der Zieltabelle:
      'Vergrößern 1.Quellspalte auf Quelltabellenbreite; Kopieren der Quelltabellenzeile
      QuZelle.Resize(, QuellSpalten).Copy
      'Vergrößern der Zieltabelle um 1 Zeile
      ZielLztZeile = Ziel.Rows.Count + 1
      Set Ziel = Ziel.Resize(ZielLztZeile)
      'Einfügen der Zwischenablagewerte in letzte Zieltabellenzeile
      Ziel.Rows(ZielLztZeile).PasteSpecial Paste:=xlValues
    End If
Nxt_QuellArtikel:
  Next QuZelle
  Application.CutCopyMode = False
End Sub
Private Function IstExistArtikelKombi(Qu As Range, Zl As Range) As Boolean
  IstExistArtikelKombi = False
  'Überprüfe, ob die Preise von Quelle und Ziel gleich sind:
  If Qu.Offset(0, 1).Value <> Zl.Offset(0, 1).Value Then Exit Function
  'Überprüfe, ob die Händler von Quelle und Ziel gleich sind:
  If Qu.Offset(0, 2).Value <> Zl.Offset(0, 2).Value Then Exit Function
  'Preise und Händler stimmen überein
  IstExistArtikelKombi = True
End Function

 

Perfekt.
Nochmals vielen Danke für die Mühe, die du dir gemacht hast.