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

VBA - Informationen aus mehreren Dateien auslesen

Frage Microsoft Microsoft Office

Mitglied: andyamo

andyamo (Level 1) - Jetzt verbinden

03.08.2010, aktualisiert 21:10 Uhr, 12914 Aufrufe, 11 Kommentare

Hallo zusammen,

leider kenne ich mich mit VBA nicht so gut aus, daher meine Frage an alle Experte, ob es möglich ist Informationen aus einer Datei auszulesen, wenn eine bestimmte Bedingung erfüllt ist.

Ich hab hier einige Dateien, die alle exakt gleich aufgebaut sind, aus denen ich Daten in eine Excelliste auslesen bzw. übertrage will.
Meine Vorstellung wäre, dass beim Klick auf einen Button alle Dateien in einem Ordner durchsucht werden, ob ein bestimmt Zelle ausgefüllt ist (E2). Sollte dies der Fall sein sollen verschiedene Zellen (B2:B10) ausgelesen und ab Zeile 11 in die Liste übertragen werden. Dabei soll für jede ausgelesene Datei eine extra Zeile angelegt werden. Schön wäre auch eine vorherige Überprüfung, ob der übertrage Name bereits vorhanden ist, um Doppeleinträge zu vermeiden.

Gibt es eine Möglichkeit sowas über ein Makro zu regeln?
Vielen Dank im Voraus!

Greetz andyamo
Mitglied: Real-TTX
03.08.2010 um 21:12 Uhr
Sollte kein Problem sein....

Schau dir mal FileSystemObject an. Damit kannst du schonmal dein Ordner durchsuchen.

Gruß, Real-TTX
Bitte warten ..
Mitglied: bastla
03.08.2010 um 21:17 Uhr
Hallo andyano und willkommen im Forum!

... auch wenn die Frage
Gibt es eine Möglichkeit sowas über ein Makro zu regeln?
durch Real-TTX eigentlich schon beantwortet ist , doch noch eine Rückfrage:
Überprüfung, ob der übertrage Name bereits vorhanden ist
Was hätte ich mir denn unter diesem "Namen" vorzustellen?

Grüße
bastla
Bitte warten ..
Mitglied: andyamo
03.08.2010 um 21:58 Uhr
..OK, scheint so als wäre ich nicht präzise genug gewesen =)

Das ganze ist eine Art Fragebogen, in den oben Angaben zur Person eingetragen werden:

B2: Name, Vorname
B3: Alter
B4: ...

Anschließend kommt der Fragebogen, je nach Antworten wird dann teilw. ein X in E2 geschreiben.

Bei der Abfrage soll dann geprüft werden, ob das X in E2 geschrieben wurde. Falls ja sollen die Personenausgaben übertragen werden:

B2 in A11, B3 in B11, usw.
Sollte Zeile 11 bereits ausgefüllt sein natürlich entsprechend die daruntere Zeile....
Zudem die vorherige Überprüfung, ob der gleiche "Name, Vorname" schon eingetragen wurde.

So, hoffe diesmal war ich präziser =)
Bitte warten ..
Mitglied: bastla
03.08.2010 um 23:36 Uhr
Hallo andyamo!

Viel besser (obwohl Du noch nicht erklärt hast, was bei bereits vorhandenen Namen passieren soll) ...

Das folgende Makro ist aus der Zieltabelle in der Sammeldatei (die übrigens nicht im selben Ordner wie die einzelnen Fragebogen-Dateien liegen darf) zu starten (ob Du einen Button einfügst oder das Makro auf andere Art startest, ist für den Ablauf egal):
01.
Sub Zusammenfassen() 
02.
 
03.
Const sSourcePath = "D:\Datensammlung" 'Ordner der Fragebogendateien - bitte anpassen 
04.
 
05.
Set wbGes = ActiveWorkbook 'aktuelle Mappe und ... 
06.
Set wsZiel = ActiveWorkbook.ActiveSheet '... aktuelle Tabelle zwischenspeichern 
07.
Set fso = CreateObject("Scripting.FileSystemObject") 
08.
 
09.
Z = 11 'ab Zeile 11 in der Sammeltabelle eintragen 
10.
sNamen = "#" 'Variable zum Sammeln der Namen vorbelegen 
11.
 
12.
Application.ScreenUpdating = False 'während der folgenden Aktionen Excel-Bildschirm "einfrieren"; diese Zeile kann auch auskommentiert / entfernt werden 
13.
For Each oFile In fso.GetFolder(sSourcePath).Files 'alle Dateien des Fragebogenordners durchgehen 
14.
    If LCase(fso.GetExtensionName(oFile.Name)) = "xls" Then 'nur .xls-Dateien bearbeiten; falls "xlsx" bitte anpassen; nur Kleinbuchstaben verwenden 
15.
        Set wbQuellDatei = Application.Workbooks.Open(oFile.Path) 'Fragebogendatei öffnen 
16.
        With ActiveWorkbook.Worksheets(1) 'Daten aus der ersten Tabelle der Fragebogendatei entnehmen 
17.
            If .Range("E2").Value <> "" Then 'E2 nicht leer? 
18.
                N = .Range("B2").Value 'Namen auslesen und ... 
19.
                If InStr(sNamen, "#" & N & "#") = 0 Then '... prüfen, ob bereits verarbeitet 
20.
                    .Range("B2:B10").Copy 'Daten kopieren und ... 
21.
                    wsZiel.Cells(Z, "A").PasteSpecial Paste:=xlPasteAll, Transpose:=True '... einfügen (dabei die Spalte als Zeile behandeln) 
22.
                    sNamen = sNamen & N & "#" 'Namen aus dem eben kopierten Datensatzes in die Liste aufnehmen 
23.
                    Z = Z + 1 'Zeilennummer der Zieltabelle für das nächste Einfügen erhöhen 
24.
                Else 'Name wurde bereits eingelesen - was nun? 
25.
                    'Aktion, falls Name bereits eingelesen wurde 
26.
                End If 
27.
            End If 
28.
        End With 
29.
        wbQuellDatei.Close 'Fragebogendatei schließen 
30.
    End If 
31.
Next 
32.
Application.ScreenUpdating = True 'Excel-Bildschirmanzeige wieder "auftauen" ;-) 
33.
wsZiel.Activate 'zur Sicherheit Zieltabelle aktivieren 
34.
wbGes.Save 'Sammeldatei speichern 
35.
MsgBox "Fertig." 
36.
End Sub
Zu überlegen wäre noch, die Inhalte ab der Zeile 11 der Sammeltabelle vorweg zu löschen ...

Grüße
bastla
Bitte warten ..
Mitglied: andyamo
04.08.2010 um 18:23 Uhr
KLASSE! Vielen Dank für die schnelle und kompetente Hilfe!

2 Fragen hätte ich noch:
- Kann man die Aktion, die ausgeführt werden soll, wenn eine "Name, Vorname"-Kombi bereits existiert, so gestalten, dass die Daten verworfen werden und er die nächste Datei einliest?

- Derzeit werden beim mehrmaligen Einlesen vorhandene Zeilen überschrieben. Gibt es eine Möglichkeit, dass er nach der nächsten komplett leeren Zeile sucht und die Daten ab dort einfügt? Löschen bzw. Überschreiben vorhandener Zellen wäre schlecht, da in den Zeilen immer auch noch Informationen von Hand eingetragen werden sollen, die nicht eingelesen werden können.

Schonmal vielen Dank für deine Hilfe!
Bitte warten ..
Mitglied: bastla
04.08.2010 um 18:31 Uhr
Hallo andyamo!

Derzeit werden zwar bereits bei Namensgleichheit die Daten verworfen - allerdings bezieht sich die Prüfung nur auf die aktuell einzulesenden Dateien. In Zukunft müssten dann ja wohl alle vorhandenen Namen ab Zelle A11 überprüft werden? (BTW: Eigentlich würde ich annehmen, dass eher die "alten" Daten verworfen bzw durch die neu Einzulesenden ersetzt werden sollten; wäre in diesem Zusammenhang ev auch ein Timestamp ein Thema?)

Das Anfügen an bereits vorhande Daten wird kein Problem sein.

Grüße
bastla
Bitte warten ..
Mitglied: andyamo
04.08.2010 um 19:58 Uhr
Zitat von bastla:
>In Zukunft müssten dann ja wohl alle vorhandenen Namen ab Zelle A11

Ja genau.

>BTW: Eigentlich würde ich annehmen, dass eher die "alten" Daten verworfen bzw durch die neu Einzulesenden ersetzt werden sollten

Wenn ich es mir recht überlege hast du recht. Die bessere Lösung wäre, dass dann in der jeweiligen Zeile, in der der Name schon steht die Daten neu eingelesen werden.
Zur Veranschaulichung:

Muster, Max 25 7xxxx --> bisher in der Liste
Muster, Max 26 7xxx1 --> gleiche Zeile nach dem Einlesen einer Datei mit gleicher Namensangabe

Hoffe das verdeutlicht was ich meine. Überschreiben sollte kein Problem sein, da es nicht vorkommen wird, dass 2 Personen den gleichen Namen haben. Daher keine Gefahr von Datenverlust.
Nochmal vielen Dank!
Bitte warten ..
Mitglied: bastla
04.08.2010 um 22:13 Uhr
Hallo andyamo!

Versuch es damit:
01.
Sub Zusammenfassen() 
02.
 
03.
Const sSourcePath = "D:\Datensammlung" 
04.
 
05.
Set wbGes = ActiveWorkbook 
06.
Set Ziel = ActiveWorkbook.ActiveSheet 
07.
Set fso = CreateObject("Scripting.FileSystemObject") 
08.
 
09.
AbZeile = 11 '(ab Zeile 11 in der Sammeltabelle eintragen) 
10.
Application.ScreenUpdating = False 
11.
For Each oFile In fso.GetFolder(sSourcePath).Files 
12.
    If LCase(fso.GetExtensionName(oFile.Name)) = "xls" Then 'nur .xls-Dateien bearbeiten 
13.
        Set wbQuellDatei = Application.Workbooks.Open(oFile.Path) 
14.
        With ActiveWorkbook.Worksheets(1) 
15.
            If .Range("E2").Value <> "" Then 'E2 nicht leer? 
16.
                N = LCase(.Range("B2").Value) 'Namen in Kleinbuchstaben auslesen und ... 
17.
                Z = AbZeile '... ab der ersten Dateienzeile ... 
18.
                '... in Spalte A suchen; falls nicht gefunden, erste Zeile ohne Eintrag in Spalte A verwenden 
19.
                Do Until Ziel.Cells(Z, "A").Value = "" Or LCase(Ziel.Cells(Z, "A").Value) = N  
20.
                    Z = Z + 1 'nächste Zeile untersuchen 
21.
                Loop 
22.
                .Range("B2:B10").Copy 'kopieren und ... 
23.
                Ziel.Cells(Z, "A").PasteSpecial Paste:=xlPasteAll, Transpose:=True '... einfügen (dabei die Spalte als Zeile behandeln) 
24.
            End If 
25.
        End With 
26.
        wbQuellDatei.Close 
27.
    End If 
28.
Next 'Datei 
29.
Application.ScreenUpdating = True 
30.
Ziel.Activate 
31.
'Gesamt-Datei speichern 
32.
wbGes.Save 
33.
MsgBox "Fertig." 
34.
End Sub
Ein Name wird nur bei (mit Ausnahme von Groß-/Kleinschreibung) identischer Schreibweise "wiedererkannt" ...

Grüße
bastla
Bitte warten ..
Mitglied: andyamo
04.08.2010 um 23:18 Uhr
Der Hammer! Vielen Dank funktioniert wunderbar!

Das war die gute Nachricht...hier die schlechte: Hab mich zwecks Übersichtlichkeit entschlossen die Liste anders zu gestalten und Zeilen und Spalten zu tauschen.
Folge: Transponde ist nicht mehr nötig.

Ich hab mal deinen Quellcode entsprechend angepasst ... er fügt die Daten auch an der richtigen Stelle ein, nur leider unter und nicht neben einander. Das Springen in die nächste Spalte (rechts), statt in die nächset Zeile bekomme ich nicht hin =(

01.
Sub Zusammenfassen() 
02.
 
03.
Const sSourcePath = "C:\Users\Andyamo\Desktop\Schlüsselpositionen\Bögen" 
04.
 
05.
Set wbGes = ActiveWorkbook 
06.
Set Ziel = ActiveWorkbook.ActiveSheet 
07.
Set fso = CreateObject("Scripting.FileSystemObject") 
08.
 
09.
AbZeile = 6 '(ab Zeile 6 in der Sammeltabelle eintragen) 
10.
Application.ScreenUpdating = False 
11.
For Each oFile In fso.GetFolder(sSourcePath).Files 
12.
    If LCase(fso.GetExtensionName(oFile.Name)) = "xls" Then 'nur .xls-Dateien bearbeiten 
13.
        Set wbQuellDatei = Application.Workbooks.Open(oFile.Path) 
14.
        With ActiveWorkbook.Worksheets(1) 
15.
            If .Range("E24").Value <> "" Then 'E24 nicht leer? 
16.
                N = LCase(.Range("C6").Value) 'Namen in Kleinbuchstaben auslesen und ... 
17.
                Z = AbZeile '... ab der ersten Dateienzeile ... 
18.
                '... in Spalte F suchen; falls nicht gefunden, erste Zeile ohne Eintrag in Spalte F verwenden 
19.
                Do Until Ziel.Cells(Z, "F").Value = "" Or LCase(Ziel.Cells(Z, "F").Value) = N 
20.
                    Z = Z + 1 'nächste Zeile untersuchen ##red|müsste nächste Spalte sein## 
21.
                Loop 
22.
                .Range("C6:C9").Copy 'kopieren und ... 
23.
                Ziel.Cells(Z, "F").PasteSpecial Paste:=xlValues, Transpose:=False '... einfügen (dabei die Spalte als Zeile behandeln) 
24.
            End If 
25.
        End With 
26.
        wbQuellDatei.Close 
27.
    End If 
28.
Next 'Datei 
29.
Application.ScreenUpdating = True 
30.
Ziel.Activate 
31.
'Gesamt-Datei speichern 
32.
wbGes.Save 
33.
MsgBox "Fertig." 
34.
End Sub
Bitte warten ..
Mitglied: bastla
04.08.2010 um 23:29 Uhr
Hallo andyamo!

Soferne ich das richtig verstanden habe, sollen jetzt also alle Datensätze in Spalten stehen? Dann wäre das Suchen des Namens aber immer in der selben Zeile durchzuführen, nicht in der Spalte "F" ...

Die Umstellung solltest Du eigentlich selbst hinbekommen, wenn Du weißt, dass "Cells" als Parameter Zeile und Spalte erwartet und die Spalte auch numerisch angegeben werden kann - es ist also dafür genauso ein Zähler möglich, wie bisher Z für die Zeile ...

Grüße
bastla

P.S.: Wenn's gar nicht klappen sollte, helfe ich natürlich noch ein wenig ...

P.P.S.: Farb- ("##red|") oder zB auch Fett-Darstellung wird in einem "Code"-Block von der Forensoftware leider ignoriert (hast Du aber auch selbst schon gemerkt) ...
Bitte warten ..
Mitglied: andyamo
05.08.2010 um 00:02 Uhr
Habs hinbekommen!
1000 Dank für deine Hilfe!
Bitte warten ..
Neuester Wissensbeitrag
Internet

Unbemerkt - Telekom Netzumschaltung! - BNG - Broadband Network Gateway

(3)

Erfahrungsbericht von ashnod zum Thema Internet ...

Ähnliche Inhalte
Microsoft Office
gelöst Per VBA im Verzeichniss dateien mit Wildcard umbenennen (4)

Frage von usenussi zum Thema Microsoft Office ...

VB for Applications
gelöst VBA - viele CSV Dateien in ein Excel sheet (2)

Frage von LordY6 zum Thema VB for Applications ...

VB for Applications
Dateien in Tabellenblat mit VBA beladen (8)

Frage von lupi1989 zum Thema VB for Applications ...

Batch & Shell
gelöst Mit Batchdatei Informationen auslesen und diese strukturiert in Excel ausgeben (9)

Frage von Flodsche zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

Grafikkarten & Monitore
Tonprobleme bei Fernseher mit angeschlossenem Laptop über HDMI (11)

Frage von Y3shix zum Thema Grafikkarten & Monitore ...

Microsoft Office
Keine Updates für Office 2016 (11)

Frage von Motte990 zum Thema Microsoft Office ...