Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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.

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
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
Anzeige
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige