6
Frage- Aus ca. 250 Excel Dateien bestimmte Zellinhalte auslesen und in neue Datei schreiben?
Hallihallo,
erst einmal meine Konfiguration: WinXP, Excel2000.
Ist-Zustand:
In diversen Unterverzeichnissen eines Ordners befinden sich ca. 250 Excel Dateien. Die Verzeichnisstruktur sieht wie folgt aus: W:\KS\%name%\DATA\DATA-%ähnlichername%.xls - Als tatsächliches Beispiel: W:\KS\Hans Meier\DATA\DATA-HMeier.xls
Es sind also ca. 250 verschiedene Unterverzeichnisse, die jeweils einen anderen Namen tragen. In diesen Unterverzeichnissen gibt es jeweils den Ordner "DATA", welcher immer so lautet. In diesem Ordner gibt es dann unter anderem die xls Datei, welche immer mit "DATA-" anfängt und mit .xls endet. Der Wert dazwischen gleicht leider nicht immer dem des Ordners "%name%". Der Name darin ist also nicht immer genau gleich geschrieben.
Was ich brauche:
Eine Excel Datei, die ein Makro beinhaltet, welches nur manuell aufgerufen werden soll. Dieses Makro soll dann, wenn gestartet, diese 250 Excel Dateien öffnen, die Inhalte bestimmter Zellen (H9[Vorname], H10[Nachname], H16[Telefon], H17[Mobil], H18[eMail], X37[Gehalt]) auslesen und in eben jene Datei schreiben (Am besten so: A=Vorname, B=Nachname, C=Telefon usw.).
Wie kann ich das bewerkstelligen? Und wie kann ich, am besten ganz oben links in dem Sheet, eine Schaltfläche mit einem Button einbauen, der das Makro auslöst?
Ich hab schon viele lustige und kniffelige Sachen mit Batchfiles geschafft. Aber bei VBA hab ich 2 linke Hände...
Vielen Dank schon mal für Eure Hilfe!!
Gruß,
nse
erst einmal meine Konfiguration: WinXP, Excel2000.
Ist-Zustand:
In diversen Unterverzeichnissen eines Ordners befinden sich ca. 250 Excel Dateien. Die Verzeichnisstruktur sieht wie folgt aus: W:\KS\%name%\DATA\DATA-%ähnlichername%.xls - Als tatsächliches Beispiel: W:\KS\Hans Meier\DATA\DATA-HMeier.xls
Es sind also ca. 250 verschiedene Unterverzeichnisse, die jeweils einen anderen Namen tragen. In diesen Unterverzeichnissen gibt es jeweils den Ordner "DATA", welcher immer so lautet. In diesem Ordner gibt es dann unter anderem die xls Datei, welche immer mit "DATA-" anfängt und mit .xls endet. Der Wert dazwischen gleicht leider nicht immer dem des Ordners "%name%". Der Name darin ist also nicht immer genau gleich geschrieben.
Was ich brauche:
Eine Excel Datei, die ein Makro beinhaltet, welches nur manuell aufgerufen werden soll. Dieses Makro soll dann, wenn gestartet, diese 250 Excel Dateien öffnen, die Inhalte bestimmter Zellen (H9[Vorname], H10[Nachname], H16[Telefon], H17[Mobil], H18[eMail], X37[Gehalt]) auslesen und in eben jene Datei schreiben (Am besten so: A=Vorname, B=Nachname, C=Telefon usw.).
Wie kann ich das bewerkstelligen? Und wie kann ich, am besten ganz oben links in dem Sheet, eine Schaltfläche mit einem Button einbauen, der das Makro auslöst?
Ich hab schon viele lustige und kniffelige Sachen mit Batchfiles geschafft. Aber bei VBA hab ich 2 linke Hände...
Vielen Dank schon mal für Eure Hilfe!!
Gruß,
nse
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 78410
Url: https://administrator.de/contentid/78410
Ausgedruckt am: 26.11.2024 um 05:11 Uhr
6 Kommentare
Neuester Kommentar
Hallo nullsechself und willkommen im Forum!
Hinsichtlich des automatischen Speicherns der Sammelmappe durch das Script habe ich zwei Varianten vorbereitet: Entweder wird nach jedem Datensatz (=nach jeder ausgelesenen Datei) oder erst am Ende gespeichert - bitte das Kommentarzeichen am Beginn der entsprechenden Zeile entfernen um das Speichern zu aktivieren.
Die Überlegungen hinsichtlich des Speicherns betreffen natürlich nur die Sammelmappe - alle Quelldateien werden nur gelesen.
Eine Schaltfläche zum Starten des Scripts aus dem Tabellenblatt heraus lässt sich sehr leicht erstellen: Dazu einfach aus den AutoFormen eine Grafik in das Blatt einzeichnen (und bei Bedarf "Text hinzufügen") oder alternativ ein ClipArt oder eine Grafik aus einer Datei einfügen und dieser per Kontextmenü das "Makro zuweisen...". Falls Du gesteigerten Wert auf eine Windows-Standard-Schaltfläche legst: diese findest Du in der "Formular"-Symbolleiste.
Grüße
bastla
... bei VBA hab ich 2 linke Hände...
Zum Anpassen des folgenden Scripts brauchst Du sicher nur eine davon: Sub Sammle()
Const BASISORDNER = "W:\KS"
Const ORDNER = "DATA"
Const DATEINAME = "DATA-"
Const DATEITYP = ".XLS"
Const ABZEILE = 4 'Eintragungen in die Zieltabelle beginnen in Zeile 4 ...
Const ABSPALTE = 1 '... und Spalte A.
QuellZellen = Split("H9,H10,H16,H17,H18,X37", ",") 'Aus diesen Zellen der Quelltabelle werden die Daten geholt.
LenDateiName = Len(DATEINAME) 'Nur einmal vor der Schleife berechnen ...
LenDateiTyp = Len(DATEITYP) '... ist etwas effektiver.
Set ZielMappe = ThisWorkbook
Set ZielTabelle = ThisWorkbook.ActiveSheet
ZielZeile = ABZEILE
Set fso = CreateObject("Scripting.FileSystemObject")
For Each NamensOrdner In fso.GetFolder(BASISORDNER).SubFolders
DatenOrdner = NamensOrdner.Path & "\" & ORDNER
If fso.FolderExists(DatenOrdner) Then 'Datenordner gefunden
For Each Datei In fso.GetFolder(DatenOrdner).Files
If UCase(Left(Datei.Name, LenDateiName)) = DATEINAME And _
UCase(Right(Datei.Name, LenDateiTyp)) = DATEITYP Then
'Datei gefunden
Set QuellMappe = Workbooks.Open(Datei.Path)
With QuellMappe.Worksheets(1) 'Daten in erstem Tabellenblatt suchen
For i = 0 To UBound(QuellZellen)
With .Range(QuellZellen(i)) 'Für jede in QuellZellen angeführte Zelle ...
ZielTabelle.Cells(ZielZeile, ABSPALTE + i).Value = .Value '... Wert und ...
ZielTabelle.Cells(ZielZeile, ABSPALTE + i).NumberFormat = .NumberFormat '... Zahlenformat übertragen
End With
Next
End With
QuellMappe.Saved = True 'Quellmappe soll ohne Rückfrage (und ohne zu speichern) ...
QuellMappe.Close '... geschlossen werden.
ZielZeile = ZielZeile + 1
'ZielMappe.Save 'Speichern der Sammelmappe nach Datenübernahme aus jeder einzelnen Datei.
End If
Next
End If
Next
'ZielMappe.Save 'Speichern der Sammelmappe erst nach Übernahme aus allen Dateien.
End SubDie Überlegungen hinsichtlich des Speicherns betreffen natürlich nur die Sammelmappe - alle Quelldateien werden nur gelesen.
Eine Schaltfläche zum Starten des Scripts aus dem Tabellenblatt heraus lässt sich sehr leicht erstellen: Dazu einfach aus den AutoFormen eine Grafik in das Blatt einzeichnen (und bei Bedarf "Text hinzufügen") oder alternativ ein ClipArt oder eine Grafik aus einer Datei einfügen und dieser per Kontextmenü das "Makro zuweisen...". Falls Du gesteigerten Wert auf eine Windows-Standard-Schaltfläche legst: diese findest Du in der "Formular"-Symbolleiste.
Grüße
bastla
Hallo bastla,
erst einmal viiiiiieeeeeelen Dank für die Mühe, die Du Dir gemacht hast!
Der Teufel steckt ja bekanntlich im Detail und gerade dieses scheint bei mir dafür zu sorgen, dass ich das Makro nicht richtig ausführen kann.
EDIT (Hier stand bis eben noch ein Text, dass es gar nicht geht): Jetzt läuft das Makro (Ich hatte einen Tippfehler bei der Anpassung drin). Allerdings bricht es irgendwann ab und spuckt eine Fehlermeldung aus.
Ich habe es auf zwei verschiedenen Rechnern getestet und bekomme zwei verschiedene Fehlermeldungen:
Rechner 1 (WinXP+Excel2000): Error 400 (mehr nicht)
Rechner 2 (WinServer2003+Excel2000): Laufzeitfehler '1004' - Anwendungs- oder objektdefinierter Fehler
Was kann ich nun tun? Der Fehler taucht übrigens immer an der selben Stelle auf. Die Datei, die in diesem Moment ausgelesen wird, unterscheidet sich von den anderen allerdings nicht.
Gruß,
nse
erst einmal viiiiiieeeeeelen Dank für die Mühe, die Du Dir gemacht hast!
Der Teufel steckt ja bekanntlich im Detail und gerade dieses scheint bei mir dafür zu sorgen, dass ich das Makro nicht richtig ausführen kann.
EDIT (Hier stand bis eben noch ein Text, dass es gar nicht geht): Jetzt läuft das Makro (Ich hatte einen Tippfehler bei der Anpassung drin). Allerdings bricht es irgendwann ab und spuckt eine Fehlermeldung aus.
Ich habe es auf zwei verschiedenen Rechnern getestet und bekomme zwei verschiedene Fehlermeldungen:
Rechner 1 (WinXP+Excel2000): Error 400 (mehr nicht)
Rechner 2 (WinServer2003+Excel2000): Laufzeitfehler '1004' - Anwendungs- oder objektdefinierter Fehler
Was kann ich nun tun? Der Fehler taucht übrigens immer an der selben Stelle auf. Die Datei, die in diesem Moment ausgelesen wird, unterscheidet sich von den anderen allerdings nicht.
Gruß,
nse
Hallo 0611!
).
Ansonsten die betreffende Datei (vorübergehend) aus dem Ordner entfernen und prüfen, ob der Fehler auch noch bei anderen Dateien auftritt, bzw, falls es sich hier um eine einmalige Datenkonsolidierung handeln sollte, die Daten aus der (hoffentlich nur) einen auffälligen Datei von Hand übernehmen.
Grüße
bastla
Was kann ich nun tun?
... zunächst einmal die Zeile, in welcher der Fehler entsteht, lokalisieren (und posten ).Ansonsten die betreffende Datei (vorübergehend) aus dem Ordner entfernen und prüfen, ob der Fehler auch noch bei anderen Dateien auftritt, bzw, falls es sich hier um eine einmalige Datenkonsolidierung handeln sollte, die Daten aus der (hoffentlich nur) einen auffälligen Datei von Hand übernehmen.
Grüße
bastla
Ich muss mich korrigieren. Es lag doch an der Datei. Ist mir nur zuerst nicht aufgefallen... 
Jetzt läuft alles wunderbar! Ich gehe nur gerade die Eventualitäten durch und dabei ist mir etwas aufgefallen:
Wenn nun aus dem Quellordner ein kompletter Unterordner gelöscht wird, also beim nächsten Auslesen ein Datensatz weniger vorhanden ist, als beim letzten Mal, werden im Sammelsheet ja zwangsläufig 2 identische Datensätze am Ende stehen. So ist es gerade beim Test auch geschehen. Kann man noch eine Zeile einbauen, die ab Zeile 5 (hab es so abgeändert) abwärts erst einmal alles ausleert, bevor die Zellen erneut befüllt werden?
Gruß,
nse
Jetzt läuft alles wunderbar! Ich gehe nur gerade die Eventualitäten durch und dabei ist mir etwas aufgefallen:
Wenn nun aus dem Quellordner ein kompletter Unterordner gelöscht wird, also beim nächsten Auslesen ein Datensatz weniger vorhanden ist, als beim letzten Mal, werden im Sammelsheet ja zwangsläufig 2 identische Datensätze am Ende stehen. So ist es gerade beim Test auch geschehen. Kann man noch eine Zeile einbauen, die ab Zeile 5 (hab es so abgeändert) abwärts erst einmal alles ausleert, bevor die Zellen erneut befüllt werden?
Gruß,
nse
Hallo 0611!
Die folgende Zeile kannst Du vor "Set fso = ..." platzieren:
Grüße
bastla
Die folgende Zeile kannst Du vor "Set fso = ..." platzieren:
ZielTabelle.Range(Rows(ABZEILE), Rows(65536)).ClearGrüße
bastla
Hallo zusammen
ich habe eine Frage zu dem ganzen.
ich will ziemlich dasselbe machen wie der Threadersteller.
Ich brauche allerdings nicht nur 4 Zellen sondern 3 Spalten aus CSV Datein (es geht auch ausgehend von xls Datein könnte man anpassen).
Es schau bei mir in etwa so aus. Geht aber auch noch nicht wirklich
01. Sub Sammle()
02. Const BASISORDNER = "O:\Mitarbeiter\KA\"
03. Const ORDNER = "DATA"
04. Const DATEINAME = "Störmeldungen" 'die Dateinen haben den gleichen Beginn aber haben dann Ziffern die entstehen abhängig vom Datum
05. Const DATEITYP = ".XLS"
06.
07. Const ABZEILE = 2 'Eintragungen in die Zieltabelle beginnen in Zeile 2 ...
08. Const ABSPALTE = 1 '... und Spalte A.
09.
10. QuellZellen = Split("N,O,P, ",") 'Aus diesen Spalten der Quelltabelle sollen die Daten geholt werden
11.
12. LenDateiName = Len(DATEINAME) 'Nur einmal vor der Schleife berechnen ...
13. LenDateiTyp = Len(DATEITYP) '... ist etwas effektiver.
14.
15. Set ZielMappe = ThisWorkbook
16. Set ZielTabelle = ThisWorkbook.ActiveSheet
17. ZielZeile = ABZEILE
18.
19. Set fso = CreateObject("Scripting.FileSystemObject")
20. For Each NamensOrdner In fso.GetFolder(BASISORDNER).SubFolders
21. DatenOrdner = NamensOrdner.Path & "\" & ORDNER
22. If fso.FolderExists(DatenOrdner) Then 'Datenordner gefunden
23. For Each Datei In fso.GetFolder(DatenOrdner).Files
24. If UCase(Left(Datei.Name, LenDateiName)) = DATEINAME And _
25. UCase(Right(Datei.Name, LenDateiTyp)) = DATEITYP Then
26. 'Datei gefunden
27. Set QuellMappe = Workbooks.Open(Datei.Path)
28. With QuellMappe.Worksheets(1) 'Daten in erstem Tabellenblatt suchen
29. For i = 0 To UBound(QuellZellen)
30. With .Range(QuellZellen(i)) 'Für jede in QuellZellen angeführte Zelle ...
31. ZielTabelle.Cells(ZielZeile, ABSPALTE + i).Value = .Value '... Wert und ...
32. ZielTabelle.Cells(ZielZeile, ABSPALTE + i).NumberFormat = .NumberFormat '... Zahlenformat übertragen
33. End With
34. Next
35. End With
36. QuellMappe.Saved = True 'Quellmappe soll ohne Rückfrage (und ohne zu speichern) ...
37. QuellMappe.Close '... geschlossen werden.
38.
39. ZielZeile = ZielZeile + 1
40. 'ZielMappe.Save 'Speichern der Sammelmappe nach Datenübernahme aus jeder einzelnen Datei.
41. End If
42. Next
43. End If
44. Next
45. ZielMappe.Save 'Speichern der Sammelmappe erst nach Übernahme aus allen Dateien.
46. End Sub
Wie gesagt ich weiß nicht wie ich die ganzen Spalten bekomme.
Und wo habe ich einen Fehler
Ich habe WinXP mit MS Off 2003
Makro arbeitet also man sieht einen Ladebalken aber es passiert nichts auch keine Fehlermeldung.
Gruß
ich habe eine Frage zu dem ganzen.
ich will ziemlich dasselbe machen wie der Threadersteller.
Ich brauche allerdings nicht nur 4 Zellen sondern 3 Spalten aus CSV Datein (es geht auch ausgehend von xls Datein könnte man anpassen).
Es schau bei mir in etwa so aus. Geht aber auch noch nicht wirklich
01. Sub Sammle()
02. Const BASISORDNER = "O:\Mitarbeiter\KA\"
03. Const ORDNER = "DATA"
04. Const DATEINAME = "Störmeldungen" 'die Dateinen haben den gleichen Beginn aber haben dann Ziffern die entstehen abhängig vom Datum
05. Const DATEITYP = ".XLS"
06.
07. Const ABZEILE = 2 'Eintragungen in die Zieltabelle beginnen in Zeile 2 ...
08. Const ABSPALTE = 1 '... und Spalte A.
09.
10. QuellZellen = Split("N,O,P, ",") 'Aus diesen Spalten der Quelltabelle sollen die Daten geholt werden
11.
12. LenDateiName = Len(DATEINAME) 'Nur einmal vor der Schleife berechnen ...
13. LenDateiTyp = Len(DATEITYP) '... ist etwas effektiver.
14.
15. Set ZielMappe = ThisWorkbook
16. Set ZielTabelle = ThisWorkbook.ActiveSheet
17. ZielZeile = ABZEILE
18.
19. Set fso = CreateObject("Scripting.FileSystemObject")
20. For Each NamensOrdner In fso.GetFolder(BASISORDNER).SubFolders
21. DatenOrdner = NamensOrdner.Path & "\" & ORDNER
22. If fso.FolderExists(DatenOrdner) Then 'Datenordner gefunden
23. For Each Datei In fso.GetFolder(DatenOrdner).Files
24. If UCase(Left(Datei.Name, LenDateiName)) = DATEINAME And _
25. UCase(Right(Datei.Name, LenDateiTyp)) = DATEITYP Then
26. 'Datei gefunden
27. Set QuellMappe = Workbooks.Open(Datei.Path)
28. With QuellMappe.Worksheets(1) 'Daten in erstem Tabellenblatt suchen
29. For i = 0 To UBound(QuellZellen)
30. With .Range(QuellZellen(i)) 'Für jede in QuellZellen angeführte Zelle ...
31. ZielTabelle.Cells(ZielZeile, ABSPALTE + i).Value = .Value '... Wert und ...
32. ZielTabelle.Cells(ZielZeile, ABSPALTE + i).NumberFormat = .NumberFormat '... Zahlenformat übertragen
33. End With
34. Next
35. End With
36. QuellMappe.Saved = True 'Quellmappe soll ohne Rückfrage (und ohne zu speichern) ...
37. QuellMappe.Close '... geschlossen werden.
38.
39. ZielZeile = ZielZeile + 1
40. 'ZielMappe.Save 'Speichern der Sammelmappe nach Datenübernahme aus jeder einzelnen Datei.
41. End If
42. Next
43. End If
44. Next
45. ZielMappe.Save 'Speichern der Sammelmappe erst nach Übernahme aus allen Dateien.
46. End Sub
Wie gesagt ich weiß nicht wie ich die ganzen Spalten bekomme.
Und wo habe ich einen Fehler
Ich habe WinXP mit MS Off 2003
Makro arbeitet also man sieht einen Ladebalken aber es passiert nichts auch keine Fehlermeldung.
Gruß
