Anzeige
Archiv - Navigation
1592to1596
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Suche in Quellatei Datei und Ausgabe in Ziel

VBA - Suche in Quellatei Datei und Ausgabe in Ziel
07.12.2017 17:27:56
Daniel
Hallo zusammen,
Ausgangssituation:
Ich habe eine Quelldatei mit 12 Tabellenblätter. Auf diesen Tabellenblättern möchte ich nach einem bestimmten Namen in Spalte D suchen können. Wird der Name in einer Zeile gefunden, soll Spalte O dieser Zeile geprüft werden, ob sie leer ist. Ist Spalte O nicht leer, soll der Inhalt der Spalten H bis L in dieser Zeile ausgelesen und in eine Zieldatei geschrieben werden. Danach soll die Suche weiterlaufen und das Spiel in jeder Zeile wiederholen, in der der Name vorkommt. Außerdem soll die Suche dann auch auf den anderen Tabellenblättern weiter laufen.
Schwierigkeit 1: Wie lässt sich die sehr aufwändige Suche und das Auslesen umsetzen?
Schwierigkeit 2: es lässt sich nicht voraussagen, wie oft ein Name in der Quelldatei vorkommt, deshalb müsste das Skript die Ausgabe in der Zieldatei "dynamisch" vornehmen können.
Nun zerbreche ich mir schon seit Tagen den Kopf, wälze unzählige Tutorial- und Forenbeiträge, aber komme auf keinen grünen Zweig. Wie kann ich das am Besten lösen?
Freundliche Grüße
Daniel

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
07.12.2017 21:48:17
guenni
Hier mal ohne Syntax aus dem Kopf, wie so ein Code aussehen müsste.

set Quelle=workbooks(Quelldateiname).worksheets(QuellsheetName)
set oldplace=quelle.range("D:D").find(suchname)
set Zielplace= workbooks(Zieldateiname).worksheets(ZielsheetName).range(Zieladresse)
do
set aktplace=quelle.range("D:D").find(suchname)
if aktplace.offset(0,11).text "" then
range(aktplace.offset(0,4),aktplace.offset(0,8)).copy
zielplace.paste
set zielplace=zielplace.offset(1,0)
endif
set oldplace=aktplace
set aktplace=quelle.range("D:D").find(suchname,after:=aktplace)
Loop until aktplace.row 

Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
08.12.2017 11:11:25
Daniel
Hallo guenni,
schon mal vielen Dank für den Code. Allerdings bricht mir der Debugger bei folgender Zeile mit Fehler "Objektvariable nicht festgelegt (Fehler 91)" ab:
If aktplace.Offset(0, 11).Text "" Then
Ich habe den Code folgendermaßen für meine Test-Dateien angepasst:
Sub Sucher()
Dim suchname As String
Dim quelle, oldplace, zielplace, aktplace As Object
Application.ScreenUpdating = False
suchname = "Muster"
Set quelle = Workbooks("Test_02.xlsx").Worksheets("01_Intern")
Set oldplace = quelle.Range("D:D").Find(suchname)
Set zielplace = Workbooks("Test.xlsm").Worksheets("Erster").Range("B:B")
Do
Set aktplace = quelle.Range("D:D").Find(suchname)
If aktplace.Offset(0, 11).Text  "" Then
Range(aktplace.Offset(0, 4), aktplace.Offset(0, 8)).Copy
zielplace.Paste
Set zielplace = zielplace.Offset(1, 0)
End If
Set oldplace = aktplace
Set aktplace = quelle.Range("D:D").Find(suchname, after:=aktplace)
Loop Until aktplace.Row 
Ich vermute, dass es an dem Set nach Do liegt, oder dass ich bei der Deklaration von aktplace einen Fehler gemacht habe. In meiner Quelldatei existieren das Tabellenblatt "01_Intern" einmal und der Suchstring "Muster" auf diesem Tabellenblatt vier mal. Das Skript sollte von den vier "Muster"-Einträgen zwei Ergebnisse liefern, da hier die Spalte O nicht leer ist.
Hast du eine Idee, warum es hier hakt?
Vielen Dank und freundliche Grüße
Daniel
Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
08.12.2017 12:36:27
guenni
Dim kann nicht mehrere Variablen in einer Zeile - nur aktplace ist object, die anderen variant.
besser:

dim Quelle as worksheet
dim OldPlace as range
dim ZielPlace as range
dim AktPlace As range

dann die anderen Parameter von find prüfen. hier werden Einstellungen von der letzten Suche beibehalten, z.B. Groß-Klein , ganzes Feld usw.
ob die Suche ein Ergebnis liefert mit "is nothing" prüfen, wäre ein sinnvolles zusätzliches Abbruchkriterium.
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
08.12.2017 16:05:33
Daniel
Jetzt habe ich es, ohne dass Fehler 91 geworfen wird: die Ranges waren vertauscht, deswegen konnte der Suchstring auch nicht gefunden werden.
Ich habe auch bei zielplace den Workbook- und Worksheet-Namen durch ActiveSheet ersetzt, da man nicht sagen kann, welche Tabellenblätter die Zieldatei haben wird. Nur die Quelldatei hat immer dieselben Tabellenblätter.
Der Suchstring wird aus Zelle A1 des aktuellen Blattes ermittelt. Das funktioniert problemlos und wird auch entsprechend an .Find übergeben.
Sub Sucher()
Dim suchname As String
Dim quelle As Worksheet
Dim oldplace As Range
Dim zielplace As Range
Dim aktplace As Range
Application.ScreenUpdating = False
Set quelle = Workbooks("Test_02.xlsx").Worksheets("01_Intern")
Set oldplace = quelle.Range("B:B").Find(What:=suchname, MatchCase:=False, LookAt:=xlWhole)
Set zielplace = ActiveSheet.Range("D:D")
suchname = ActiveSheet.Range("A1")
Do
Set aktplace = quelle.Range("B:B").Find(What:=suchname, MatchCase:=False, LookAt:=xlWhole)
If aktplace Is Nothing Then
MsgBox "Name nicht gefunden."
GoTo Ausgang
If aktplace.Offset(0, 11).Text  "" Then
Range(aktplace.Offset(0, 4), aktplace.Offset(0, 8)).Copy
zielplace.Paste
Set zielplace = zielplace.Offset(1, 0)
End If
End If
Set oldplace = aktplace
Set aktplace = quelle.Range("B:B").Find(What:=suchname, MatchCase:=False, LookAt:=xlWhole,  _
After:=aktplace)
Loop Until aktplace.Row 
Allerdings schmiert mir nun Excel mit "Keine Rückmeldung" ab, wenn ich das Skript über meine Test-Datei mit nur vier Einträgen laufen lasse. Das muss ich mir aber am Montag nochmal ansehen.
Vielen Dank und schönes Wochenende
Daniel
Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
08.12.2017 18:27:05
guenni
Voraussichtlich funktioniert das Abbruchkriterium nicht.
im Beispiel wird da der Oldplace nur beim ersten Mal belegt
und als Abbruchkriterium auf Suchergebnis is nothing oder gleiche Adresse wie Oldplace geprüft.
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
11.12.2017 15:19:18
Daniel
Ich habe jetzt noch ein weiteres Problem gefunden:
If aktplace.Offset(0, 11).Text  "" Then
MsgBox "Eintrag gefunden!"
GoTo Ausgang
aktplace.Range(aktplace.Offset(0, 4), aktplace.Offset(0, 5)).Copy _
Destination:=zielplace
Set zielplace = zielplace.Offset(1, 0)
Else
MsgBox "Die Suche funktioniert nicht!"
GoTo Ausgang
End If
Keine der beiden MsgBoxen, die ich zum Testen der Anweisungen eingebaut habe, werden ausgelöst, weder "Eintrag gefunden", noch "Die Suche funktioniert nicht!". Ich habe schon mit den Offset-Werten gespielt (sogar (0, 0)), statt "" auch mal verschiedene Texte ausprobiert, auch verschiedene Operatoren, statt .Text .Value ausprobiert, aber nichts triggert die Boxen. Das heißt, dass sämtlicher restlicher Code in dieser If-Anweisung ebenfalls nicht ausgeführt wird. Woran könnte das liegen? Ich bekomme keine Fehlermeldung angezeigt.
Range und seine Methoden sind mir noch recht neu. Ich weiß, dass .Find im restlichen Code aus dem vorherigen Post funktioniert und den Suchwert auch übernimmt. Aber mit Offset habe ich noch keine Erfahrungen zum Verhalten.
Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
12.12.2017 15:45:48
Daniel
Öhm, ja, nun weiß ich, weshalb der Block nicht ausgeführt wurde: ich hatte im vorhergehenden Block dummerweise das Else gelöscht... wie peinlich!
Der Code wird nun ausgeführt, ich konnte noch ein paar Erweiterungen einbauen, allerdings tritt nun folgendes Problem auf: es werden anscheinend nur die ersten zwei Zeilen der Quelle durchsucht und dann aufgehört. Befindet sich der Vergleichswert von Spalte O erst in Zeile 3, bricht das Programm ab und triggert meine MsgBox mit "Die Suche funktioniert nicht!". Steht der Wert in Zeile 1 oder 2, wird der Code als Endlosschleife ausgeführt und dieselbe Zeile bis zum Abbruch in meine Zieldatei kopiert. Die Suche springt nicht zur nächsten Zeile weiter. Guenni schrieb, dass das Abbruchkriterium nicht funktioniert. Ich bräuchte hier mal einen Denkanstoß, wie es denn funktionieren könnte. Momentan stehe ich auf dem Schlauch.
Hier mal der bisherige Code:
Sub Sucher()
Dim strSuchname As String
Dim wsQuelle As Worksheet
Dim rgOldplace As Range
Dim rgZielplace As Range
Dim rgAktplace As Range
' "Flackern" abschalten:
Application.ScreenUpdating = False
' Suchbegriff aus Zelle im aktiven Arbeitsblatt holen:
strSuchname = ActiveSheet.Range("A1")
' Auszulesendes Arbeitsblatt in externer Datei festlegen:
Set wsQuelle = Workbooks("Test_02.xlsx").Worksheets("01_Intern")
' Suche in Spalte D der auszulesenden Datei nach Begriff:
Set rgOldplace = wsQuelle.Range("D:D").Find(What:=strSuchname, MatchCase:=False, LookAt:= _
xlWhole)
' Füge Gefundenes in Spalte B der aktiven Arbeitsmappe ein:
Set rgZielplace = ActiveSheet.Range("B:B")
Do
Set rgAktplace = wsQuelle.Range("D:D").Find(What:=strSuchname, MatchCase:=False, LookAt:= _
xlWhole)
' Wenn Zelle leer, dann gib Fehlermeldung aus:
If rgAktplace Is Nothing Then
MsgBox "Name nicht gefunden."
GoTo Ausgang
Else
' Wenn Wert in Spalte O ist nicht leer, dann kopiere die Spalten H bis L aus der externen Datei  _
und füge sie in die aktive Datei ein:
If rgAktplace.Offset(0, 11).Value  "" Then
rgAktplace.Range(rgAktplace.Offset(-1, 1), rgAktplace.Offset(-1, 2)).Copy _
Destination:=rgZielplace
rgAktplace.Range(rgAktplace.Offset(-1, 4), rgAktplace.Offset(-1, 5)).Copy _
Destination:=rgZielplace.Offset(0, 2)
Set rgZielplace = rgZielplace.Offset(1, 0)
Else
' Gib Laut, wenn die Suche nicht funktioniert:
MsgBox "Die Suche funktioniert nicht!"
GoTo Ausgang
End If
End If
Set rgOldplace = rgAktplace.Offset(1, 0)
Set rgAktplace = wsQuelle.Range("D:D").Find(What:=strSuchname, MatchCase:=False, LookAt:= _
xlWhole, After:=rgAktplace)
' Abbruchkrierium festglegen:
Loop Until rgAktplace.Value  rgOldplace.Value
' "Flackern" wieder einschalten:
Application.ScreenUpdating = True
Ausgang:
End Sub
Wie man an einigen Ecken und Kanten erkennen kann, bin ich nicht das Code-Genie. Das Programm ist das aufwändigste, an dem ich bisher gebastelt habe. Man möge mir also bitte unsauberen oder unschönen Code verzeihen. Ich bin über jede Hilfe und jeden Verbesserungsvorschlag froh und dankbar.
Daniel
Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
13.12.2017 11:13:18
guenni
Hallo Daniel,
sorry, dass ich keine Zeit hatte.
Habe Dir 2 Dateien gemacht,
eine mit Makro
https://www.herber.de/bbs/user/118303.xlsm
und eine Beispiel-Quelldatei dazu
https://www.herber.de/bbs/user/118304.xlsx (umbenennen in Test_02.xlsx)
Tipps:
- Im Code nach !! suchen
- in Code auf Find klicken und F1 drücken; das Beispiel dort mit dem Code vergleichen
Grüße,
Günther
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
14.12.2017 16:10:22
Daniel
Hallo Günther,
vielen Dank für die Dateien, echt cool!
Find mit After ist mir jetzt langsam klar, die Suchfunktion läuft jetzt auch durch ohne Endlosschleife.
Allerdings sind die Suchergebnisse seltsam: das erste stimmt, dann werden mir Ergebnisse ausgegeben, die gar nicht zu meiner Suche passen. In meiner Test-Tabelle habe ich 30 Einträge, davon sollte das Programm 6 Treffer für den Suchbegriff "Muster" und 6 Treffer für den Begriff "Mann" ausgeben. In der Zieldatei landen bei "Muster" allerdings nur fünf Treffer, wobei der letzte eigentlich zu "Mann" gehört. Suche ich nach "Mann", gibt es mir gar nichts zurück. Mit dem Einzelschritt-Debugger kann ich sehen, dass die Kopierfunktion bei "Mann" das erste Mal in der leeren Zeile 40 durchgeführt wird. Wie kommt Find darauf? Die Offsets beim Kopieren sind auch seltsam, da muss ich (-1, 1) angeben, um die korrekte erste Zelle kopieren zu können. Wenn Find die Spalte D durchsucht, müsste es doch eher (0, 4) heißen, oder? Wenn ich das ausprobiere, lande ich in Spalte G der nächsten Zeile...
Hier ist meine Test-Quelle:
https://www.herber.de/bbs/user/118335.xlsx
Und hier deine Datei, an der ich noch ein paar Änderungen bei den Find-Parametern und dem PasteSpecial getestet habe:
https://www.herber.de/bbs/user/118336.xlsm
Vielen Dank und viele Grüße
Daniel
Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
18.12.2017 16:18:14
guenni
Hast Du das inzwischen hinbekommen?
Hauptproblem dürfte jetzt das Verständnis von Range sein, musste auch erst 3 Mal hinschauen.
relevante Zeilen:

Range(rgAktplace.Offset(0, 1), rgAktplace.Offset(0, 2)).Copy
und
Range(rgAktplace.Offset(0, 4), rgAktplace.Offset(0, 5)).Copy
Gruß,
Günther
Gruß,
Günther
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
19.12.2017 11:48:53
Daniel
Hallo Günther,
danke fürs Nachfragen. Ich hatte erst heute Zeit, nochmal zu testen. Ich habe die Offsets so eingestellt, wie du vorgeschlagen hast und es auch nach meinem Verständnis logisch wäre:
rgAktplace.Range(rgAktplace.Offset(0, 4), rgAktplace.Offset(0, 2)).Copy
rgZielplace.PasteSpecial xlPasteValues
rgAktplace.Range(rgAktplace.Offset(0, 4), rgAktplace.Offset(0, 5)).Copy
rgZielplace.Offset(0, 2).PasteSpecial xlPasteValues
Als Ergebnis erhalte ich nun bei der Suche nach "Muster" folgende Ergebnisse:
ok		ok	ok
Fehler 4		ok	ok
ok		ok	ok
ok		ok	Fehler 13
Fehler 10		ok	ok
Zeile 1 und 3 hätten gar nicht angezeigt werden dürfen, da sie nicht den Kriterien entsprechen.
Zeile 2 und 4 sind korrekt.
Zeile 5 ist falsch, da hier der Suchbegriff gar nicht vorkommt.
Außerdem sind das nicht die Spalten, die ich zurückgeben möchte, sondern sie sind um eine oder ein paar Spalten nach rechts verschoben.
Außerdem fehlen noch vier Zeilen dazwischen, auf die die Kriterien zutreffen.
Nun stelle ich die Offsets ein, die ich in meinem vorigen Beitrag beschrieben habe:
rgAktplace.Range(rgAktplace.Offset(-1, 1), rgAktplace.Offset(-1, 2)).Copy
rgZielplace.PasteSpecial xlPasteValues
rgAktplace.Range(rgAktplace.Offset(-1, 4), rgAktplace.Offset(-1, 5)).Copy
rgZielplace.Offset(0, 2).PasteSpecial xlPasteValues
Jetzt sieht das Ergebnis folgendermaßen aus:
1	Fehler 1	ok	ok
7	ok	ok	ok
9	ok	ok	ok
15	Fehler 5	ok	ok
29	ok	ok	Fehler 14
Zu Allererst: es werden nun die richtigen Spalten ausgegeben.
Aber: Zeilen 2 und 3 sind falsch, hier treffen die Kriterien nicht zu.
Zeilen 1 und 4 sind korrekt.
Zeile 5 ist falsch, da hier der Suchbegriff nicht vorkommt.
Außerdem fehlen auch hier vier Zeilen dazwischen, die den Kriterien entsprechen würden.
Ich weiß, dass Find die Spalte D durchsucht. Ich möchte beim Eintreffen meiner Kriterien Spalten H, I, K und L ausgeben. Logisch wäre, hier das Offset auf (0, 4), (0, 5), (0, 7) und (0, 8) zu setzen. Dann gibt es aber die Spalten I, J, L und M aus.
Setze ich das Offset auf (-1, 1), (-1, 2), (-1, 4) und (-1, 5), dann gibt es mir H, I, K und L aus. Hier sogar mit der ersten Zeile, in der der Fehler auftritt. Ersetze ich die -1 mit 0, wird die erste Fehlerzeile einfach übergangen, die restlichen Ergebnisse sind aber genauso teilweise falsch und einfach unvollständig:
2	ok	ok	ok
8	Fehler 4	ok	ok
10	ok	ok	ok
16	ok	ok	Fehler 13
30	Fehler 10	ok	ok
Das alles tritt bei der Suche nach "Muster" auf. Wende ich meinen zweiten Suchbegriff "Mann" an, der in meiner Test-Quelldatei genauso oft wie "Muster" in der Liste vorkommt, kopiert es mir nur leere Zeilen in meine Zieldatei, weil es dann um etwa 10 Zeilen nach unten verrutscht. Diese 10 Zeilen werden allerdings nirgendwo im Code angegeben.
Verstehst du meine Verwirrung? Entweder verhält sich das Programm unlogisch, oder ich denke in die falsche Richtung. Hast du eine Idee, was falsch sein könnte?
Viele Grüße
Daniel
Anzeige
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
19.12.2017 11:51:09
guenni
Du musst das erste rgAktplace vor range weglassen!
AW: VBA - Suche in Quellatei Datei und Ausgabe in Ziel
22.12.2017 10:36:03
Daniel
Günther, das Programm tut nun was es soll!
Vielen Dank für deine Hilfe und deine Geduld, ich hätte das alleine nie hinbekommen.
Frohe Weihnachten und guten Rutsch!
Daniel

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige