Excel SVerweis per Makro

Hallo, ich bin auf der Suche nach einer Lösung für folgendes Problem:

Ich habe in Datei1.xlsx in Spalte A Werte und in Spalte B dazugehörige Kommetare. Das sieht aus wie folgt:

123 Kommentar1
456 Kommentar2
789 Kommentar3

Nun habe ich in Datei2.xlsx ggf. wieder die Werte aus Datei1 SpalteA. Sofern ein Wert in Datei1 enthalten war soll der dazugehörige Kommentar in Spalte B wiedergegeben werden. Ist der Wert nicht enthalten soll die Zelle leer sein.

Im Prinzip ist das per SVerweis machbar, nur suche ich das als Makro!

Zusätzlich soll in Zelle A1 der Pfad der Datei1 stehen (so dass der Dateiname variiert werden kann), ab A2 soll die Suche beginnen. Wie folgt sieht Datei2 aus:

C:\Datei1.xlsx
456 Kommentar2
654
789 Kommentar3
321

Irgendein Makro-Spezialist hier?? Ich habe leider gar keine Ahnung von VBA, weiss nur wie ich es per Copy&amp:stuck_out_tongue_winking_eye:aste reinkopiere…
Bin für jede Hilfe dankbar!

Danke & Gruß

Da binn ich leider überfragt, tut mir leid.

Auf VBA Basis muss ich passen.

Hi,
ich versuche erst mal, dein Problem in meine Worte zu fassen, um sicher zu gehen, dass ich dich richtig verstanden habe.

In Datei 2 hast du ab Zeile 2 jeweils in Splate A eine Wert stehen. Das Makro soll nun den zugehörigen Kommentar aus einer anderen Datei suchen und in Spalte B dahinter eintragen. Die Datei, in der das Makro suche soll, steht in Zelle A1 der Datei 2.
Korrekt?
Falls ja: kein Problem - kann ich dir schreiben und schicken.
Bleibt die Frage: Wie soll das Makro aufgerufen werden? Ich sehe drei Möglichkeiten:
a) direkt über Alt-F8, Makro auswählen
b) über einen shortcut (z.B. strg u)
c) über einen Pushbutton

Gruß
Volker

Hi Volker,

ja ich denke Du hast mein Problem absolut richtig verstanden. Im Prinzip eben eine ganz einfacher SVerweis. Wenn Du mir das in ein Makro basteln könntest wäre das echt suuuuper!!!
Ach und ja, das Makro soll dann über einen Button in Datei 2 gestartet werden (wie ich den einfüge und das Makro damit verlinke weiss ich).

Bin ganz gespannt auf Deine Hilfe.

Beste Grüße

Hier das makro (s.u).
Folgende Annahmen habe ich getroffen.
Falls di nicht zutreffen, müssen ggf.Änderungen erfolgen.

  1. sowohl in datei1 als auch in datei 1 gibt es in Splate A keine Lücken, d.h., sobald ich den ersten leeren Eintrag hier finde, breche ich ab.
  2. Der Reiter in datei1, in dem die auszulesenden daten stehen, hießt „Quelle“. Falls er anders heißt, bitte ändern. Überall wo „Sheets(„Quelle“)“ steht.
  3. ich habe keine großen Aufwand für das Abfangen von Fehlern eingebaut (Ausnahme: falls die Datei, die in Zelle A1 konfiguriert ist, nicht exirtiert. dann bricht das Makro ab.

Ich hab’s bei mir getestet. Probier’s aus. Bei Fragen melde dich.

=============================
Option Explicit

Sub Update()

Dim a, WorkbookSenke, WorkbookQuelle, DateiPfad, DateiName As Variant
Dim PosBackSlash, i, j As Integer

’ Aktuelles Workbook feststellen
WorkbookSenke = ActiveWorkbook.Name

’ Ermittle DateiPfad und DateiName
DateiPfad = Cells(1, 1)
PosBackSlash = InStr(1, DateiPfad, „“, 1)
DateiName = Mid(DateiPfad, PosBackSlash + 1)

’ Öffne Datei
On Error Resume Next
Workbooks.Open Filename:=DateiPfad
If Err.Number 0 Then
’ Fehlermeldung
a = MsgBox(DateiPfad & " existiert nicht", vbOKOnly, „Abbruch der Verarbeitung“)
Exit Sub
Else
On Error GoTo 0
WorkbookQuelle = ActiveWorkbook.Name
End If

Workbooks(WorkbookSenke).Activate

i = 2
While Cells(i, 1) „“
j = 1
While Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, 1) „“ _
And Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, 1) Cells(i, 1)
j = j + 1
Wend
If Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, 1) = Cells(i, 1) Then
Cells(i, 2) = Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, 2)
Else
Cells(i, 2) = „“
End If
i = i + 1
Wend

'QuellDatei schließen
Workbooks(WorkbookQuelle).Close SaveChanges:=False

End Sub

Volker, das ist EXZELLENT!!!
Es funktioniert einwandfrei. Das ist echt klasse. Tausend Dank! Weiss gar nichtw ie ich das wieder gutmachen kann :smile:

Hab noch eine Frage… wenn ich das Makro jetzt noch etwas modifizieren will, d.h. wenn er z.B. in Datei 1 nicht in Zelle A1 anfangen soll mit der Suche sondern z.B. in B2, wo ändere ich das?
Ebenso wenn die Daten in Datei 2 nicht ab Zeile A2 beginnen sondern meinetwegen erst in Zelle B3 - welches Feld ist hierfür verantwortlich?

Wenn Du mir da noch helfen kannst wäre das aller erste Sahne und vielleicht werde ich ja dann auch mal ein VBA Spezialist :smile:

Ein glücklicher User…

-)

Hi,
ich habe das Ganze mal parametrisiert.
Ich hoffe die Begriffe sind selbsterklären.
Vorsicht: Ich habe dieses Teil nicht getestet (weil ich auf meinem privatem PC kein XLS habe. Ich muss dafür auf mein Firmen Notebook gehen, und da war ich heute abend zu faul zu… … falls also ein Fehler auftaucht oder das Ganze nicht funktioniert - lass es mich wissen, …
Die Startwerte sind aktuell so gesetzt, wie bisher, also: Datei 1 hat seine Werte in den Spalten 1 und 2 beginnend in Zeile 1. Datei 2 hat seine Werte in den Spalten 1 und 2 beginnend in Zeile 2. Die konfigurierte Datei steht in Zelle A1 (sprich Zeile 1 und Splate 1)
Diese 6 Startwerte kannst du ändern.

Gruß
Volker

=============================
Option Explicit

Sub Update()

Dim a, WorkbookSenke, WorkbookQuelle, DateiPfad, DateiName As Variant
Dim PosBackSlash, i, j, D1StartZeile, D1StartSpalte, D2StartZeile, D2StartSpalte, D2D1Zeile, D2D1Spalte As Integer

’ Aktuelles Workbook feststellen
WorkbookSenke = ActiveWorkbook.Name

’ Hier werden die Startwerte gesetzt
’ Datei1
D1StartZeile = 1
D1StartSpalte = 1
’ Datei2
D2StartZeile = 2
D2StartSpalte = 1
’ Wo ist in Datie 2 der Pfad von Datei 1 konfiguriert
D2D1Zeile = 1
D2D1Spalte = 1

’ Ermittle DateiPfad und DateiName
DateiPfad = Cells(D2D1Zeile , D2D1Spalte)
PosBackSlash = InStr(1, DateiPfad, „“, 1)
DateiName = Mid(DateiPfad, PosBackSlash + 1)

’ Öffne Datei
On Error Resume Next
Workbooks.Open Filename:=DateiPfad
If Err.Number 0 Then
’ Fehlermeldung
a = MsgBox(DateiPfad & " existiert nicht", vbOKOnly, „Abbruch der Verarbeitung“)
Exit Sub
Else
On Error GoTo 0
WorkbookQuelle = ActiveWorkbook.Name
End If

Workbooks(WorkbookSenke).Activate

i = D2StartZeile
While Cells(i, 1) „“
j = D1StartZeile
While Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1StartSpalte) „“ _
And Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1StartSpalte) Cells(i, D2StartSpalte)
j = j + 1
Wend
If Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1StartSpalte) = Cells(i, D2StartSpalte) Then
Cells(i, D2StartSpalte + 1) = Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1StartSpalte + 1)
Else
Cells(i, D2StartSpalte + 1) = „“
End If
i = i + 1
Wend

'QuellDatei schließen
Workbooks(WorkbookQuelle).Close SaveChanges:=False

End Sub

Auch das funktioniert einwandfrei!
Um absolut damit herzubasteln fehlt allerdings noch ein kleiner Parameter… und zwar welcher Wert bestimmt welche Spalte wiedergegeben wird?
Momentan sucht er ja in Datei 1 den Wert aus Spalte A und gibt den Wert aus Spalte B wieder. Wenn der Wert jetzt zudem nicht mehr in Spalte B steht sondern z.B. in Spalte E, was muss ich dann anpassen? Ersetze ich alle „D2StartSpalte + 1“ durch „D2StartSpalte + 4“? Funktioniert leider irgendwie nicht.

Hi,
sorry, konnte nicht früher.
Du hast einen Denkfehler. Es geht dir doch darum, aus welcher Spalte in Datei 1 er die Daten holt. Also mußt du „D1StartSpalte + 1“ entsprechnd ersetzen.
Klar?
Gruß
Volker

Hi Volker,
wenn ich ehrlich bin hab ich’s net ganz geblickt… kannst Du es nochmal anders erklären?

Vielleicht hab ich auch die Startwerte falsch verstanden - Daher zu den Startwerten noch ne Frage:
D1StartZeile & D1StartSpalte = die Stelle in der der Suchwert steht? Oder ist das die Stelle, in der die Werte stehen die in D2 kopiert werden sollen?
D2StartZeile & D2StartSpalte = die Stelle, in der der Suchwert steht oder die Stelle an der die Daten kopiert werden sollen?

Wie gesagt, im oben genannten Beispiel waren die Suchdaten ja immer in Spalte A und die Daten die kopiert wurden in Spalte B. Wenn ich jetzt eine leere Spalte dazwischen habe, ändere ich also nur „D1StartSpalte + 1“ ab, d.h. Spalte C?

Dankeeeeee

Volker,
sorry wenn ich nerve… aber konntest Du hier schon was rausfinden?
Danke Dir!

Hi,
ich hab’s nochmal umgeschrieben (aber wieder nicht testen können, falls es nicht läuft, melde dich …).
Da wo steht " Hier werden die Startwerte gesetzt " kannst du konfigurierend eingreifen. Ich habe die Startwerte mit Kommentaren versehen, die das hoffentlich erklären.

=============================
Option Explicit

Sub Update()

Dim a, WorkbookSenke, WorkbookQuelle, DateiPfad, DateiName As Variant
Dim PosBackSlash, i, j, D1StartZeile, D1StartSpalte, D2StartZeile, D2StartSpalte, D2D1Zeile, D2D1Spalte As Integer

’ Aktuelles Workbook feststellen
WorkbookSenke = ActiveWorkbook.Name

’ Hier werden die Startwerte gesetzt
’ allgemein gilt bei den Splatenwerten 1=A, 2=B, 3=C etc

’ Datei1
D1StartZeile = 1 'Zeile, in der in D1 die Suche beginnt
D1SuchSpalte = 1 'Spalte, in der in D1 gesucht wird
D1DatenSpalte = 1 'Spalte, aus der in D1 die Daten kopiert werden

’ Datei2
D2StartZeile = 2 'Zeile, bei der die Verarbeitung in Datei 2 beginnt
D2SuchwertSpalte = 1 'Spalte, in der in D2 der zu suchende Wert steht
D2DatenSpalte = 1 'Spalte, in der in D2 die aus D1 kopierten Daten eingetragen werden sollen

’ Wo ist in Datie 2 der Pfad von Datei 1 konfiguriert
D2D1Zeile = 1
D2D1Spalte = 1

’ Ermittle DateiPfad und DateiName
DateiPfad = Cells(D2D1Zeile , D2D1Spalte)
PosBackSlash = InStr(1, DateiPfad, „“, 1)
DateiName = Mid(DateiPfad, PosBackSlash + 1)

’ Öffne Datei
On Error Resume Next
Workbooks.Open Filename:=DateiPfad
If Err.Number 0 Then
’ Fehlermeldung
a = MsgBox(DateiPfad & " existiert nicht", vbOKOnly, „Abbruch der Verarbeitung“)
Exit Sub
Else
On Error GoTo 0
WorkbookQuelle = ActiveWorkbook.Name
End If

Workbooks(WorkbookSenke).Activate

i = D2StartZeile
While Cells(i, 1) „“

j = D1StartZeile
While Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) „“ _
And Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) Cells(i, D2SuchwertSpalte)
j = j + 1
Wend

If Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) = Cells(i, D2SuchwertSpalte) Then
Cells(i, D2DatenSpalte) = Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1DatenSpalte)
Else
Cells(i, D2DatenSpalte) = „“
End If
i = i + 1
Wend

'QuellDatei schließen
Workbooks(WorkbookQuelle).Close SaveChanges:=False

End Sub

Gruß
Volker

Hi Volker,

da kommt leider eine Fehlermeldung „Fehler beim Kompilieren: Variable nicht definiert“

Ich habe einfach mal diese fehlenden Variablen (D1SuchSpalte, D1DatenSpalte, D2Datenspalte, D2SuchwertSpalte) in diesen Absatz ergänzt:

Dim a, WorkbookSenke, WorkbookQuelle, DateiPfad, DateiName As Variant
Dim PosBackSlash, i, j, D1StartZeile, D1StartSpalte, D2StartZeile, D2StartSpalte, D2D1Zeile, D2D1Spalte, D1SuchSpalte, D1DatenSpalte, D2Datenspalte, D2SuchwertSpalte As Integer

Wenn ich dies mache kommt die Fehlermeldung nicht mehr und das Makro läuft, allerdings werden keine Daten ausgegeben… kannst Du nochmal schauen??

Danke Dir

Hallo,

ich kann Dir leider nicht weiterhelfen, da ich mich mit SVerweis keinerlei Übung und Erfahrung habe.

Tut mir leid

BinBerl

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

Hallo,

das mit der Deklaration (also die Zeile die mit „Dim“ beginnt) war schon mal die richtige Idee.
Ich hab das Teil jetzt mal auf meinen anderen Rechner transferiert und es funktioniert.
Ich vermute also, dass du die Parameter falsch gesetzt hast.

Hier mal ein Beispiel für
-> suche in Spalte 2 (also B) in D1
-> ziehe Daten aus Spalte 5 (also E) in D1
-> Suchbegriffe stehen in Spalte 1 (also A) von D2
-> Daten werden eingetragen in Spalte 4 (also D) in D2

’ Datei1
D1StartZeile = 1
D1SuchSpalte = 2
D1DatenSpalte = 5

’ Datei2
D2StartZeile = 2
D2SuchwertSpalte = 1
D2DatenSpalte = 4

Hi Volker,

also Du hast nur zum Teil Recht :smile: Hab nochmal probiert und tatsächlich… so wie Du sagst funktioniert es.
Sobald ich aber die Daten in Datei2 nicht in Spalte 1 (Spalte A) sondern 2 beginne, funktioniert es nicht mehr. D.h. solange Parameter D2SuchwertSpalte = 1 ist funktioniert es, wenn D2SuchwertSpalte >1 ist funktioniert es nicht mehr.

…wir sind doch so nah dran… :frowning:

Hi,

saudoofer Fehler bei der Erweiterung von Spalte 1 auf beliebige Spalten:
Verändere die Zeile im Makro
While Cells(i,1) „“
in
While Cells(i,D2SuchwertSpalte) „“

Gruß
Volker

Volker,

aller erste Sahne! Funktioniert ohne Probleme :smile:
Tausend Dank!!!

Hey Volker, also das funktioniert wie geschmiert! :smile:
Ich hab mal ne Frage bzgl Feintuning… wäre es möglich eine Fortschrittsanzeige einzubauen die anzeigt wielange es noch dauert bis die Verarbeitung zu Ende ist? Am besten in Prozent oder einfach ein Timer der runterläuft…