Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

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

Frage Microsoft Microsoft Office

Mitglied: nullsechself

nullsechself (Level 1) - Jetzt verbinden

17.01.2008, aktualisiert 01.09.2008, 10850 Aufrufe, 6 Kommentare

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
Mitglied: bastla
18.01.2008 um 01:59 Uhr
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:
01.
Sub Sammle() 
02.
Const BASISORDNER = "W:\KS" 
03.
Const ORDNER = "DATA" 
04.
Const DATEINAME = "DATA-" 
05.
Const DATEITYP = ".XLS" 
06.
 
07.
Const ABZEILE = 4  'Eintragungen in die Zieltabelle beginnen in Zeile 4 ... 
08.
Const ABSPALTE = 1 '... und Spalte A. 
09.
 
10.
QuellZellen = Split("H9,H10,H16,H17,H18,X37", ",") 'Aus diesen Zellen der Quelltabelle werden die Daten geholt. 
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
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
Bitte warten ..
Mitglied: nullsechself
18.01.2008 um 09:32 Uhr
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
Bitte warten ..
Mitglied: bastla
18.01.2008 um 12:12 Uhr
Hallo 0611!

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
Bitte warten ..
Mitglied: nullsechself
18.01.2008 um 12:46 Uhr
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
Bitte warten ..
Mitglied: bastla
18.01.2008 um 14:37 Uhr
Hallo 0611!

Die folgende Zeile kannst Du vor "Set fso = ..." platzieren:
01.
ZielTabelle.Range(Rows(ABZEILE), Rows(65536)).Clear
Grüße
bastla
Bitte warten ..
Mitglied: Sim-Master
01.09.2008 um 21:08 Uhr
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ß
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...