nullsechself
Jan 17, 2008, updated at Sep 01, 2008 (UTC)
view11593
view6
0
Goto Top

Frage- Aus ca. 250 Excel Dateien bestimmte Zellinhalte auslesen und in neue Datei schreiben?

GermanQuestionMicrosoft OfficeMicrosoft
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... face-sad

Vielen Dank schon mal für Eure Hilfe!!

Gruß,
nse
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 78410

Url: https://administrator.de/contentid/78410

Printed on: April 20, 2024 at 02:04 o'clock

6 Comments
Latest comment
Goto Top
Member: bastla
bastla Jan 18, 2008 at 00:59:08 (UTC)
Goto Top
Hallo nullsechself und willkommen im Forum!

... bei VBA hab ich 2 linke Hände...
Zum Anpassen des folgenden Scripts brauchst Du sicher nur eine davon: face-wink
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 Sub
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
Member: nullsechself
nullsechself Jan 18, 2008 at 08:32:20 (UTC)
Goto Top
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
Member: bastla
bastla Jan 18, 2008 at 11:12:58 (UTC)
Goto Top
Hallo 0611!

Was kann ich nun tun?
... zunächst einmal die Zeile, in welcher der Fehler entsteht, lokalisieren (und posten face-wink).

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
Member: nullsechself
nullsechself Jan 18, 2008 at 11:46:22 (UTC)
Goto Top
Ich muss mich korrigieren. Es lag doch an der Datei. Ist mir nur zuerst nicht aufgefallen... face-smile

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
Member: bastla
bastla Jan 18, 2008 at 13:37:12 (UTC)
Goto Top
Hallo 0611!

Die folgende Zeile kannst Du vor "Set fso = ..." platzieren:
ZielTabelle.Range(Rows(ABZEILE), Rows(65536)).Clear

Grüße
bastla
Member: Sim-Master
Sim-Master Sep 01, 2008 at 19:08:22 (UTC)
Goto Top
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ß
GermanQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment