Auswerten von Exceltabs - Ergebnis in neue Excel

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… :wink:

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

  • MVP für MS-Excel -

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 :smile:

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 :smile:

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 :wink: