Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.06.2024 22:07:02
25.06.2024 21:01:55
25.06.2024 19:21:44
Anzeige
Archiv - Navigation
1128to1132
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bestimmte Zeilen aus mehreren Dateien auslesen

Bestimmte Zeilen aus mehreren Dateien auslesen
mari
Hallo zusammen,
ich soll aus mehreren Excel Dateien die in einem Ordner liegen (my_Documents)eine bestimmte Information raus lesen und diese in eine neue Datei reinschreiben. Dies würde manuell mehrere Stunden gar Tage dauern. Deswegen würde ich euch gerne um eure Hilfe bitten.
Ein Makro wäre toll, welches Datei für Datei aus dem Ordner ausließt und aus jeder Datei aus dem ersten Sheet (welche unterschiedlich heißen) G6 abfragen, ob hier eine 1 oder eine 0 steht.
Steht hier eine 1 soll in eine neu erstellte Datei diese Info reingeschrieben werden, sowie die Info welche in G1 drin steht.
Steht in G6 eine 0 soll dies ignoriert werden und die Spalte J6 (3 weiter) abgefragt werden. Dies solange bis in einer Spalte nichts mehr drin steht.
Ich hab mal ein Beispiel hochgeladen:

Ich hoffe es ist verständlich und ihr könnt mir weiter helfen.
Gruß mari
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
12.01.2010 09:53:17
Tino
Hallo,
geht es mit diesem Code?
Pfad musst wo die Dateien sind noch anpassen.
Tabelle wo die Daten ab A12 eingefügt werden sollen auch anpassen. (im Bsp. Tabelle1)
Sub LeseInfo()
Dim sFile$, meArFile()
Dim A&, AA&
Dim meArData()
Dim oExcelFile As Workbook
Dim iCalc%

'Ordner anbgeben am Ende auf "\" achten 
Const strPath$ = "C:\MeinOrdner\"

sFile = Dir(strPath & "*.xls")
'Dateien sammeln 
Do While sFile <> ""
 Redim Preserve meArFile(A)
 meArFile(A) = strPath$ & sFile
 A = A + 1
 sFile = Dir()
Loop

If A > 0 Then
    With Application
        iCalc = .Calculation
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        
            Redim Preserve meArData(1 To 3, 1 To A)
            
            'Dateien durchsuchen 
            For A = Lbound(meArFile) To Ubound(meArFile)
                Set oExcelFile = Workbooks.Open(meArFile(A), ReadOnly:=True)
                With oExcelFile.Worksheets(1)
                      If .Cells(6, 7) = 1 Then
                        AA = AA + 1
                        meArData(1, AA) = .Cells(1, 7)
                        meArData(2, AA) = .Cells(6, 7)
                        meArData(3, AA) = oExcelFile.Name
                      End If
                      oExcelFile.Close SaveChanges:=False
                End With
            Next A
            
            'Tabelle anpassen wo die Daten hin sollen ************************** 
            With Sheets("Tabelle1")
                .Range("A12").Resize(.Rows.Count - 12, 3).ClearContents
                If AA > 0 Then
                    Redim Preserve meArData(1 To 3, 1 To AA)
                    .Range("A12").Resize(AA, 3) = Application.Transpose(meArData)
                Else
                    MsgBox "Keine Datei mit 1 in G6 gefunden", vbInformation
                End If
            End With
            
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = iCalc
    End With
Else
    MsgBox "Keine Excel- Datei im Ordner", vbInformation
End If

End Sub
Gruß Tino
Anzeige
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
12.01.2010 11:31:24
mari
Hallo Tino,
erstmal vielen Dank für deine Mühe.
Ich habe dein Code mal kopiert und getestet ..
Es funktioniert ZUM TEIL
Dh er durchsucht tatsächlich den ordner "C:\MeinOrdner\"
und sammelt alle xls. Das ist supi.
Allerdings hab ich das gefühl, dass er nur G6 abfragt und dann in die neue Datei reinschreibt.
J6 + M6 + P6 werden irgendwie ignoriert obwohl da eine 1 drin ist.
Kannst du bitte nochmal einen Blick darauf werfen?
Grüße
mari
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
12.01.2010 10:41:23
fcs
Hallo mari,
hier meine Makro-Lösung erstellt unter Excel 2003 - sollte aber auch unter 2007 laufen.
Gruß
Franz
Sub DatenImportieren()
Dim sVerzeichnis$, sDatei$
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim wksZiel As Worksheet, wksQuelle As Worksheet
Dim ZeileZ&, FileCount&
Dim Zelle As Range
Const StartZelle$ = "G6" '1. Auszulesende Zelle in Tabelle 1
Const Schritt& = 3 'Spaltenabstand der auszulesenden Zellen
On Error GoTo Fehler
'Suchverzeichnis auswahlen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner mit zu durchsuchenden Dateien wählen"
.ButtonName = "Auswälen"
If .Show = -1 Then
sVerzeichnis = .SelectedItems(1)
sDatei = Dir(sVerzeichnis & Application.PathSeparator & "*.xl*")
If sDatei  "" Then
'neue Datei mit einem Tabellenblatt für Ergebnisdaten erstellen
Set wbZiel = Workbooks.Add(Template:=xlWBATWorksheet)
'Zieltabellenblatt Objektvariable zuweisen
Set wksZiel = wbZiel.Worksheets(1)
ZeileZ = 1
With wksZiel
'Titelzeile ausfüllen
.Cells(ZeileZ, 1) = "Info"
.Cells(ZeileZ, 2) = "Stück"
.Cells(ZeileZ, 3) = "Dateiname"
End With
End If
Application.ScreenUpdating = False
Do Until sDatei = ""
FileCount = FileCount + 1
Application.StatusBar = "Datei, laufende Nr. " & FileCount & " wird bearbeitet."
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open( _
Filename:=sVerzeichnis & Application.PathSeparator & sDatei, _
ReadOnly:=True)
'Tabelle1 Objektvariable zuweisen
Set wksQuelle = wbQuelle.Worksheets(1)
'Werte aus Blatt 1 auslesen
Set Zelle = wksQuelle.Range(StartZelle)
Do Until IsEmpty(Zelle)
If Zelle.Value  0 Then
ZeileZ = ZeileZ + 1
With wksZiel
'Info aus Zeile 1 eintragen
.Cells(ZeileZ, 1) = wksQuelle.Cells(1, Zelle.Column).Value
'Stückzahl eintragen
.Cells(ZeileZ, 2) = Zelle.Value
'Dateiname eintragen
.Cells(ZeileZ, 3) = sDatei 'gespeicherter Dateiname
'              .Cells(ZeileZ, 3) = wksQuelle.Cells(1, 1).Value 'Dateinem in A1 des Quellblatts
End With
End If
'Nächste Zelle setzen
Set Zelle = Zelle.Offset(0, Schritt)
Loop
wbQuelle.Close savechanges:=False
Set wksQuelle = Nothing
Set wbQuelle = Nothing
sDatei = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Alle Dateien ausgelesen"
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
Application.ScreenUpdating = True
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
If Not wbQuelle Is Nothing Then wbQuelle.Close savechanges:=False
End Select
End With
Set wbZiel = Nothing
Set wbQuelle = Nothing
Application.StatusBar = False
End Sub

Anzeige
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
12.01.2010 11:43:42
mari
Hallo Franz,
vielen Dank für deine Mühe.
Es öffnet sich sogar ein Fenster wo ich den Ordner auswählen kann .. wahnsinn !! Danke
Nach dem ersten Test hat das wunderbar funktioniert.
Nachdem er fertig ist bekomm ich allerdings noch die Fehlermeldung:
Fehler-Nr.:9
Index außerhalb des gültigen Bereichs
Das ist aber denk ich mal weiterhin nicht schlmm oder?
Gruß mari
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
12.01.2010 13:57:55
fcs
Hallo mari,
keine Ahnung, warum die Meldung kommt, obwohl scheinbar alles ok durchläuft.
Füge noch folgende Zeile vor "Fehler:" ein, dann sollte auch das nicht passieren.
  Err.Clear
Fehler:

Gruß
Franz
Anzeige
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
12.01.2010 14:24:09
mari
Hallo Franz,
gesagt getan ! Und du hattest recht. Der Fehler kommt nicht mehr. Dankeschön !
Ich hätte noch eine Frage.
Wenn in einer der Zeilen eine 1 steht zB G6 hab ich ja geschrieben, dass er dann die Info aus G1 auch kopieren soll.
Wenn die Info jetzt aber nicht in G1 steht sondern in F1 also IMMER 1 vor dem wo ich beschrieben habe.
Wo kann ich das in deinem Code ändern?
Hier?
'Info aus Zeile 1 eintragen
.Cells(ZeileZ, 1) = wksQuelle.Cells(1, Zelle.Column).Value
Gruß
mari
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
12.01.2010 17:46:11
fcs
Hallo mari,
dann muss man von der Spalten-Nummer noch 1 abziehen, damit as F1 statt G1 der Wert ausgelesen wird.
'Info aus Zeile 1 eintragen
.Cells(ZeileZ, 1) = wksQuelle.Cells(1, Zelle.Column - 1).Value

Gruß
Franz
Anzeige
AW: Bestimmte Zeilen aus mehreren Dateien auslesen
13.01.2010 09:38:49
mari
Hallo Franz,
supi. Vielen vielen Dank
Gruß mari

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige