Hallo alle sammen
Ich stöpere schon länger in den Forum herum und bin teilweise fasziniert wie schnell Lösungen gefunden werden. Nun habe ich ein Thema was mit den bereits vorhanden Themen nicht zu lösen ist.
Folgende Vorraussetzung:
Es gibt einen festen Hauptordner zur Datenablage dieser heißt z.B. „Nacharbeit“
In diesem Ordner sind unterordner vorhanden welche auf Kalenderwochen aufgeteilt sind z.B. „KW22“
In den Unterordnern sind für jeden Tag eine Sammelliste von Bauteilen (Exeltabellen). Es gibt nur ein Tabellenblatt und in dem ist an einer immer gleichbleibenden Zellenposition das Datum vorhanden. In den Zeilen werden Informationen zusammengefasst wie Bauteilname + Sachnummer + Anzahl + Fehler… halt alles mögliche
Ziel ist es das ich einer neuen Excel in einem Eingabefenster meinen Suchparameter z.B. Stecker eingeben kann und das Macro alle Excelsheets in den Unterordner durchsucht, wenn er einen treffer hat soll er das datum (in Spalte A)+ (in Spalte ab B) die komplette Zeile in der der Treffer gefunden wurde in meine neue Exel reinkopieren.
Es soll also möglich sein nachträglich festzustellen ob ein Teil in der letzten Zeit gehäuft benannt wurde.
Hoffe das ist nicht zu kompliziert geschrieben und Ihr versteht was ich meine.
MfG Joachim
Es gibt einen festen Hauptordner zur Datenablage dieser heißt
z.B. „Nacharbeit“
In diesem Ordner sind unterordner vorhanden welche auf
Kalenderwochen aufgeteilt sind z.B. „KW22“
In den Unterordnern sind für jeden Tag eine Sammelliste von
Bauteilen (Exeltabellen). Es gibt nur ein Tabellenblatt und in
dem ist an einer immer gleichbleibenden Zellenposition das
Datum vorhanden. In den Zeilen werden Informationen
zusammengefasst wie Bauteilname + Sachnummer + Anzahl +
Fehler… halt alles mögliche
Ziel ist es das ich einer neuen Excel in einem Eingabefenster
meinen Suchparameter z.B. Stecker eingeben kann und das Macro
alle Excelsheets in den Unterordner durchsucht, wenn er einen
treffer hat soll er das datum (in Spalte A)+ (in Spalte ab B)
die komplette Zeile in der der Treffer gefunden wurde in meine
neue Exel reinkopieren.
Hallo Joachim,
du teilst nicht klar mit in welcher Spalte die Bezeichnungen stehen.
Ich hab mal B genommen, also die 2te Spalte.
Ändere ggfs. die 2 im Code ab.
Genauso ggfs. den Pfad zu „Nachtarbeit“.
Im Code sind die drei potentiellen Änderungsstellen bezeichnet.
Alt+F11, Einfügen—Modul, Code reinkopieren, ggfs. anpassen, Editor schließen.
Aufruf in Excel mit Alt+F8—Ausführen…
Code (ungetestet) müßte bis Version 2003 funktionieren.
Gruß
Reinhard
Option Explicit
Sub Suche()
Dim fs As FileSearch, F As Long, wks As Worksheet, Eing, ZeiA As Long
Dim Zei As Long
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set wks = ActiveSheet
Set fs = Application.FileSearch
Eing = InputBox("Bezeichnung?", "Artikelsuche")
If Eing = "" Then Exit Sub
Zei = 1
With fs
.LookIn = "C:\Nacharbeit" 'Anpassen
.SearchSubFolders = True
.Filename = "KW\*.xls"
If .Execute() \> 0 Then
For F = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(F)
If F = 1 Then Rows(1).Copy Destination:=wks.Cells(1, 1)
For ZeiA = 1 To Cells(Rows.Count, 2).End(xlUp).Row 'Anpassen
If Cells(ZeiA, 2).Value = Eing Then 'Anpassen
Zei = Zei + 1
Rows(ZeiA).Copy Destination:=wks.Cells(Zei, 1)
End If
Next ZeiA
ActiveWorkbook.Close savechanges:=False
Next F
End If
End With
End Sub
Erster Testlauf war erfolgreich. Er hat alle Exeldats aufgemacht und durchsucht. Er hat mir aber keine Zeilen umkopiert. Kann es sein das dieses Makro genau nach dem Stichwort sucht? Also wenn ich z.B. „Kerze“ eingebe würde er die Zeile wo das Wort „Zündkerze wechseln“ drin ist nicht kopieren?
Also das Makro lief ohne fehler durch und hat die richtigen Exceltabs aufgemacht.
Nachtrag:
Das Datum steht immer im Feld C3 -> bei einem Treffer soll er also das Feld C3 auslesen und in die Sammlung mit eintragen am besten eine Spalte vor dem kopierten Text.
Die Informationen welche ich durchsuchen will stehen immer in der Spalte C (Zellen C bis O sind da verbunden)
Grüezi Happydoncar
Kann es sein das dieses Makro genau nach dem
Stichwort sucht? Also wenn ich z.B. „Kerze“ eingebe würde er
die Zeile wo das Wort „Zündkerze wechseln“ drin ist nicht
kopieren?
Ja, so hattest Du das in deinem ersten Beitrag ja auch formuliert… 
IMO reicht es wenn Du die folgende Zeile:
If Cells(ZeiA, 2).Value = Eing Then 'Anpassen
so abänderst
If Instr(Cells(ZeiA, 2).Value, Eing) > 0 Then 'Anpassen
Mit freundlichen Grüssen
Thomas Ramel
Hallo Joachim,
Erster Testlauf war erfolgreich. Er hat alle Exeldats
aufgemacht und durchsucht. Er hat mir aber keine Zeilen
umkopiert. Kann es sein das dieses Makro genau nach dem
Stichwort sucht? Also wenn ich z.B. „Kerze“ eingebe würde er
die Zeile wo das Wort „Zündkerze wechseln“ drin ist nicht
kopieren?
ja.
wechsle
If Cells(ZeiA, 2).Value = Eing Then
gegen
If InStr(UCase(Cells(ZeiA, 2).Value), UCase(Eing)) > 0 Then
Nachtrag:
Das Datum steht immer im Feld C3 -> bei einem Treffer soll er
also das Feld C3 auslesen und in die Sammlung mit eintragen am
besten eine Spalte vor dem kopierten Text.
Die Informationen welche ich durchsuchen will stehen immer in
der Spalte C (Zellen C bis O sind da verbunden)
Den Nachtrag verstehe ich nicht, es wird doch die ganze zeile herauskopiert. Soll nicht die ganze Zeile herauskopiert werden?
Ich schaue heute Abend wieder hier rein.
Gruß
Reinhard
Korrektur der IIF formel
da fehlt doch was *gg*
If IIf(IIf(Cells(Zei, 4) \> 10 Or Cells(Zei, 5) \> 10, True, False) \_
Or Cells(Zei, 6) \> 10, True, False) Then MsgBox \_
"Mindestens ein positiver Eintrag"
Gruß
Reinhard
Guten Tag,
Hatte den skript soweit am laufen das er die Exceltabellen durchlaufen ist und in der richtigen Tabelle was gefunden hat und es umkopieren wollte. Da sties er dann auf einen Fehler.
Die Textzeile in der das Makro den Treffer hat ist eine verbundene Zelle (C bis O). Beim Kopieren der gesammten Zeile stösst er auf einen Fehler und sagt das er verbundene Zellen nicht kopieren kann.
Hoffe du verstehst was ich meine
MfG Joachim
Guten Tag,
Guten Tag,
Hatte den skript soweit am laufen das er die Exceltabellen
durchlaufen ist und in der richtigen Tabelle was gefunden hat
und es umkopieren wollte. Da sties er dann auf einen Fehler.
Die Textzeile in der das Makro den Treffer hat ist eine
verbundene Zelle (C bis O). Beim Kopieren der gesamten Zeile
stösst er auf einen Fehler und sagt das er verbundene Zellen
nicht kopieren kann.
Hoffe du verstehst was ich meine
MfG Joachim
Nachtrag:
Fehlermeldung ist „Laufzeitfehler '1004“
Markieren sie eine einzelne Zelle und wähle sie dann ‚einfügen‘
Markieren sie einen Bereich, der dieselbe Grösse und Form hat und wählen Sie dann ‚Einfügen‘
Weitere Fragen:
Die Kopierfunktion für Zelle C3 (wo das Datum immer steht) fehlt noch. Ist eine Mehrfachnennung in einer Exel berücksichtigt?
Hoffe du schaffst es mir nochmal zu helfen.
Achja… Wo muss ich diesen Code denn einfügen?
If IIf(IIf(Cells(Zei, 4) > 10 Or Cells(Zei, 5) > 10, True, False) _
Or Cells(Zei, 6) > 10, True, False) Then MsgBox _
„Mindestens ein positiver Eintrag“
Marko läuft
hatte in einer Zeile einen Fehler drin und den gefunden. Nun ist es mehr als pefekt durchgelaufen. Mehrfachnennungen wurden berücksichtigt und umkopiert.
Eins bleibt aber noch offen 
Zelle C3 (Datum der durchsuchten Excel) muss bei Treffer noch umkopiert werden.
Makro fertig
Hallo alle sammen
Dank Reinhard musste ich mich dann doch mit dem Makro beschäftigen und verstehen lernen und habe es dann geschafft mit seiner Vorgabe das Datum einzufügen. Es läuft perfekt
Danke Reinhard für die Zuarbeit
Sub Suche()
Dim fs As FileSearch, F As Long, wks As Worksheet, Eing, ZeiA As Long
Dim Zei As Long
Dim ZellenInhalt As String
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set wks = ActiveSheet
Set fs = Application.FileSearch
Eing = InputBox(„Bezeichnung?“, „Artikelsuche“)
If Eing = „“ Then Exit Sub
Zei = 1
With fs
.LookIn = „C:\Ordner“ 'Anpassen - Welcher Ordener soll durchsucht werden
.SearchSubFolders = True
.Filename = „*.xls“
If .Execute() > 0 Then
For F = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(F)
ZellenInhalt = Range(„C3“).Value 'Anpassen Datum aus Zelle C3
If F = 1 Then Rows(1).Copy Destination:=wks.Cells(1, 1)
For ZeiA = 1 To Cells(Rows.Count, 3).End(xlUp).Row 'Anpassen Suchort 3 = Spalte C
If InStr(UCase(Cells(ZeiA, 3).Value), UCase(Eing)) > 0 Then 'Anpassen 3 = Spalte C
Zei = Zei + 1
Rows(ZeiA).Copy Destination:=wks.Cells(Zei, 1) 'komplette Zeile wird umkopiert
wks.Cells(Zei, 2).Value = ZellenInhalt 'Datum wird in Spalte B kopiert
End If
Next ZeiA
ActiveWorkbook.Close savechanges:=False
Next F
End If
End With
End Sub
Beim umkopieren der kompletten Zeile bleibt die Spalte B leer. Deswegen habe ich nach dem umkopieren die Spalte B neu befüllt.
Ich habe Reinhards letzte Änderung nicht einfliesen lassen. Ich habe nicht verstanden was diese bewirkt und wohin die muss und es läuft grad so gut