Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.10.2025 17:57:35
Zellen-Name aus A1 nach H1 übertragen mit Prä- + Suffix
17.10.2025 11:36:58
verschachteltes Dropdown-Menü
17.10.2025 10:28:49
Call Anweisung
16.10.2025 18:38:17
Zusammenfassung nach Personalnummer
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1588to1592
1588to1592
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Suchen - Finden - Eintragen - mehrere Spalten

Forumthread: VBA Suchen - Finden - Eintragen - mehrere Spalten

VBA Suchen - Finden - Eintragen - mehrere Spalten
02.11.2017 15:39:41
Peter
Hallo zusammen,
leider wurde mein Thread schon archiviert, deshalb muss ich einen neunen Aufmachen.
Ich habe zwei Listen die sich gegenseitig abgleichen sollen. Beide Listen haben 9 Spalten. Jede Zeile bildet einen Datensatz.
Mein Makro soll anhand der ersten drei Spalten prüfen, ob der Datensatz in der anderen Tabelle vorhanden ist. Findet es einen Datzensatz mit drei identischen Spalten, soll der Rest gleichgesetzt werden. Ist der Datensatz nicht vorhanden, wird er in die erste freie Zeile eingetragen.
Mein Code: 

Sub Abgleich()
Dim wkb As Workbook
Dim wkb1 As Workbook
Dim wks As Worksheet
Dim wks1 As Worksheet
Workbooks.Open "Hier steht der Dateipfad"
Set wkb = Workbooks("Name der Datei")
Set wkb1 = ThisWorkbook
wkb1.Activate
Set wks = wkb.Worksheets("Tabelle1") 'MASTERliste
Set wks1 = wkb1.Worksheets("Sheet1") 'Schülerliste
anz = wks.Cells(65536, 1).End(xlUp).Row
anz1 = wks1.Cells(65536, 1).End(xlUp).Row
For Z = 3 To anz1            ' Schleife läuft von 3 bis anz1(65536)
suchwert = wks1.Range(Cells(Z, 1), Cells(Z, 3))
With wks.Range("a3:a" & anz)
Set C = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
For S = 1 To 11
wks.Cells(C.Row, S) = wks1.Cells(Z, S)
Next
Else
For S = 1 To 11
wks.Cells(anz + 1, S) = wks1.Cells(Z, S)
Next
anz = wks.Cells(65536, 1).End(xlUp).Row
End If
End With
Next
wkb.Save
wkb.Close
Application.ScreenUpdating = True
End Sub

Mein Problem:
Mein Makro sucht anscheinend nur anhand der ersten Spalte und nicht nach meinem Bereich. Wo liegt mein Fehler?
Vielen Dank vorab!
Grüße,
Peter
P.S Ich habe den Code im Archiv gefunden und an mein Problem angepasst.
Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Suchen - Finden - Eintragen - mehrere Spalten
02.11.2017 16:10:02
Peter(silie)
Hallo,
ohne Beispiel Mappe will man bei sowas ungern helfen, da man einen haufen nachbauen muss.
Du kannst keine Range einfach so abgleichen.
Du musst die einzelnen Zellwerte nacheinander vergleichen.
Man könnte zwar einen algorithmus schreiben der anhand v. bestimmten kriterien
eine Quersumme bildet und diese dann abgleichen, aber naja, muss man nicht, geht auch nacheinander.
Also: Zellen nacheinander abgleichen -> Range erstellen(temporär) -> range übertragen -> nächste Zeile
Ich würde dir aber grundsätzlich empfehlen, die Ranges in arrays zu speichern,
die arrays gleichst du ab und änderst diese auch ab, anschließend fügst du dass array wieder in
die Range ein, z.b. mit Range.Resize.Value = array()
Hier hast du mal einen ungetesteten Code:
(keinen schimmer ob er funktioniert, der wird langsam und grausam durchlaufen) 
Option Explicit
Public Sub abgleich()
Dim wkb As Workbook
Dim wks, wks1 As Worksheet
Dim lRow, lRow_1 As Long
Dim rng, rng1, c, cc As Range
Set wkb = Workbooks.Open("laksjdfkljasdkfj")
Set wks = wkb.Sheets("lkasdjflöjl")
Set wks1 = ThisWorkbook.Sheets("lkajsdflj")
lRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
lRow_1 = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
With wks
Set rng = .Range(.Cells(1, 1), .Cells(lRow, 1))
End With
With wks1
Set rng1 = .Range(.Cells(1, 1), .Cells(lRow_1, 1))
End With
For Each c In rng
For Each cc In rng1
If c.Value = cc.Value Then
If c.Offset(, 1).Value = cc.Offset(, 1).Value And _
c.Offset(, 2).Value = cc.Offset(, 2).Value Then
Dim tmp As Range
With wks1
Set tmp = .Range(.Cells(cc.Row, 1), .Cells(cc.Row, 11))
End With
With wks
.Range(.Cells(c.Row, 1), .Cells(c.Row, 11)).Value = tmp.Value
End With
Set tmp = Nothing
End If
End If
Next cc
Next c
End Sub

Anzeige
AW: VBA Suchen - Finden - Eintragen - mehrere Spalten
03.11.2017 09:48:27
Peter
Danke für die Antwort. Dein Code funktioniert allerdings nicht bei mir. Das mein Code langsam läuft ist mir auch schon aufgefallen. Gibt es dafür einen "schnelleren"?
Hier mal mein Beispiel:
Userbild
Die Mappen sind identisch.
Grüße
Peter
Anzeige
Für eine Beispielmappe reicht es nicht?
03.11.2017 13:04:22
Werner
Hallo Peter,
eine Beispielmappe ist immer noch nicht dabei. Nachbauen will das hier wohl eher keiner.
Dann wäre da noch eine Frage:
Tab1 wird mit Tab2 verglichen
-in welchem Tab sollen die Daten "gleichgesetzt/angefügt" werden?
Gruß Werner
AW: Für eine Beispielmappe reicht es nicht?
06.11.2017 08:57:15
Peter
Entschuldigung!
Hier die beiden Mappen:
https://www.herber.de/bbs/user/117419.xlsx
https://www.herber.de/bbs/user/117420.xlsx
Die Daten sollen in beiden Tabellen gleichgesetzt/angefügt werden. Später werden mehrere Schülerlisten existieren, die auf die Mastertabelle zugreifen. Dazu ist es nötig, dass in beide Richtungen der Abgleich funktioniert. Sollte dass den Code zu langsam machen, kann der Abgleich auch auf zwei Makros aufgeteilt werden.
Grüße
Peter
Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

VBA Suchen, Finden und Eintragen in mehreren Spalten

Schritt-für-Schritt-Anleitung

Um Datensätze in Excel mithilfe von VBA zu suchen und zu finden, kannst du das folgende Makro verwenden. Es vergleicht die ersten drei Spalten zweier Listen und gleichsetzt die restlichen Spalten, wenn ein Datensatz gefunden wird. Falls nicht, wird der Datensatz in die nächste freie Zeile eingetragen.

  1. Öffne die Excel-Mappe, in der du das Makro verwenden möchtest.
  2. Gehe zu Entwicklertools > Visual Basic.
  3. Erstelle ein neues Modul über Einfügen > Modul.
  4. Kopiere den nachfolgenden Code und füge ihn in das Modul ein:
Sub Abgleich()
    Dim wkb As Workbook
    Dim wkb1 As Workbook
    Dim wks As Worksheet
    Dim wks1 As Worksheet
    Workbooks.Open "Hier steht der Dateipfad"
    Set wkb = Workbooks("Name der Datei")
    Set wkb1 = ThisWorkbook
    Set wks = wkb.Worksheets("Tabelle1") 'MASTERliste
    Set wks1 = wkb1.Worksheets("Sheet1") 'Schülerliste
    anz = wks.Cells(65536, 1).End(xlUp).Row
    anz1 = wks1.Cells(65536, 1).End(xlUp).Row
    For Z = 3 To anz1
        suchwert = wks1.Range(Cells(Z, 1), Cells(Z, 3))
        With wks.Range("A3:A" & anz)
            Set C = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
            If Not C Is Nothing Then
                For S = 1 To 11
                    wks.Cells(C.Row, S) = wks1.Cells(Z, S)
                Next
            Else
                For S = 1 To 11
                    wks.Cells(anz + 1, S) = wks1.Cells(Z, S)
                Next
                anz = wks.Cells(65536, 1).End(xlUp).Row
            End If
        End With
    Next
    wkb.Save
    wkb.Close
    Application.ScreenUpdating = True
End Sub
  1. Ändere die Dateipfade und die Tabellennamen entsprechend deiner Daten.
  2. Führe das Makro aus, um den Abgleich durchzuführen.

Häufige Fehler und Lösungen

  • Problem: Das Makro sucht nur anhand der ersten Spalte.

    • Lösung: Stelle sicher, dass du den Suchwert korrekt definierst. Du möchtest die ersten drei Spalten vergleichen.

  • Problem: Das Makro läuft langsam.

    • Lösung: Verwende Arrays für den Datensatzabgleich, um die Geschwindigkeit zu verbessern. Arrays sind in der Regel schneller als das Arbeiten mit Zellen direkt.

Alternative Methoden

Ein alternativer Ansatz ist die Verwendung von Arrays, um die Daten in einem schnellen und effizienten Verfahren abzugleichen:

Public Sub abgleich()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wks1 As Worksheet
    Dim lRow As Long
    Dim rng As Range
    Set wkb = Workbooks.Open("Pfad zur Datei")
    Set wks = wkb.Sheets("Tabelle1")
    Set wks1 = ThisWorkbook.Sheets("Tabelle2")
    lRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
    Set rng = wks.Range("A1:A" & lRow)
    Dim dataArr As Variant
    dataArr = rng.Value
    ' Hier folgt der Vergleich und das Einfügen der Daten
End Sub

Praktische Beispiele

Hier ist ein Beispiel, wie du zwei Excel-Tabellen abgleichen kannst:

  • Tabelle1 (Masterliste): A B C D
    ID1 Name1 20 ...
    ID2 Name2 25 ...
  • Tabelle2 (Schülerliste): A B C D
    ID1 Name1 21 ...
    ID3 Name3 30 ...

Nach dem Ausführen des Makros werden die Einträge in Tabelle1 aktualisiert oder neue Einträge aus Tabelle2 hinzugefügt.

Tipps für Profis

  • Verwende Application.ScreenUpdating = False, um die Bildschirmaktualisierung während des Makro-Laufs zu deaktivieren. Dies beschleunigt die Ausführung.
  • Setze Fehlerbehandlungen ein, um Probleme während des Ablaufs zu vermeiden.
  • Kommentiere deinen Code ausführlich, damit du die Logik später leichter nachvollziehen kannst.

FAQ: Häufige Fragen

1. Funktioniert das Makro in Excel 365? Ja, das Makro sollte in Excel 365 und anderen Versionen von Excel funktionieren, die VBA unterstützen.

2. Wie kann ich das Makro anpassen, um mehr Spalten zu vergleichen? Du kannst die Schleifen und den Suchbereich im Code anpassen, um die gewünschten Spalten zu vergleichen.

3. Was mache ich, wenn ich keine VBA-Kenntnisse habe? Es ist empfehlenswert, sich zuerst mit den Grundlagen von VBA vertraut zu machen. Es gibt viele Online-Ressourcen und Tutorials, die dir helfen können.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige