Excel-VBA Suchsystem

Question

Hallo Zusammen,

ich arbeite gerade an einem Excel-VBA-Projekt und benötige Hilfe.

Ich habe zwei Excel – Dateien, die ca. wie folgt aussehen:

Datei 1:
Spalte A Spalte B
1 Test1
2 Test2
3 Test3
4 usw.

Datei 2:
Spalte A Spalte B
1 leer
3
2
2
3

Das Makro soll dann mittels einer Schleife anfangen, die Daten aus Datei 1/Spalte A (jede Zeile) in Datei 2/Spalte A zu suchen. Wenn die Daten gefunden worden sind, dann soll er die Daten aus Spalte B/ Datei 1 in Spalte B Datei 2 übertragen. Als Kennung dienen als immer die Daten aus den Spalten 1.

Das alles soll mittels einer Schleife funktionieren. Weiter hat die Excel-Datei mehrere Mappen. Er soll den Vorgang immer auf alle Mappen in der Datei anwenden.

Noch einmal zusammengefasst:

Das Makro beginnt mit der Zeile 1 aus Datei 1 und sucht diesen in der Datei 2 in jeder Mappe. Wenn er damit fertig ist, geht er zur nächsten Zeile usw.

Ich hoffe ich habe mich verständlich ausgedrückt.
Ich habe zwar schon öfters leichte bis mittler Makros programmiert, allerdings übersteigt diese bei weitem meine Fähigkeiten. Ich hoffe dass mir jemand hier helfen kann.

Answer 1

hi all :-)

beide dateien sind geöffnet

gruss nighty

Option Explicit

Sub ArraySucheKopie()
Dim QuelleZeilen As Long
Dim ZielZeilen As Long
Dim ZelleZiel As Long
Dim WksAnz As Integer
Dim ZelleQuelle As Long
Workbooks(1).Worksheets(1).Activate
QuelleZeilen = Workbooks(1).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
ReDim ArrayQuelle(1 To QuelleZeilen, 2) As Variant
ArrayQuelle = Range(Cells(1, 1), Cells(QuelleZeilen, 2))
For WksAnz = 1 To Workbooks(2).Worksheets.Count
Workbooks(2).Worksheets(WksAnz).Activate
ZielZeilen = Workbooks(2).Worksheets(WksAnz).UsedRange.SpecialCells(xlCellTypeLastCell).Row
ReDim ArrayZiel(1 To ZielZeilen, 2) As Variant
ArrayZiel = Range(Cells(1, 1), Cells(ZielZeilen, 2))
For ZelleQuelle = 2 To QuelleZeilen
For ZelleZiel = 2 To ZielZeilen
If ArrayQuelle(ZelleQuelle, 1) = ArrayZiel(ZelleZiel, 1) Then
ArrayZiel(ZelleZiel, 2) = ArrayQuelle(ZelleQuelle, 2)
End If
Next ZelleZiel
Next ZelleQuelle
Range(Cells(1, 1), Cells(ZielZeilen, 2)).Resize(UBound(ArrayZiel())) = ArrayZiel
Next WksAnz
Workbooks(1).Worksheets(1).Activate
End Sub