Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

Bestimmte Zeilen aus mehreren Dateien auslesen | Herbers Excel-Forum


Betrifft: Bestimmte Zeilen aus mehreren Dateien auslesen von: mari
Geschrieben am: 12.01.2010 08:36:23

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:
Image and video hosting by TinyPic

Ich hoffe es ist verständlich und ihr könnt mir weiter helfen.

Gruß mari

  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: Tino
Geschrieben am: 12.01.2010 09:53:17

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


  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: mari
Geschrieben am: 12.01.2010 11:31:24

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


  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: fcs
Geschrieben am: 12.01.2010 10:41:23

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



  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: mari
Geschrieben am: 12.01.2010 11:43:42

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


  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: fcs
Geschrieben am: 12.01.2010 13:57:55

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


  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: mari
Geschrieben am: 12.01.2010 14:24:09

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


  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: fcs
Geschrieben am: 12.01.2010 17:46:11

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


  

Betrifft: AW: Bestimmte Zeilen aus mehreren Dateien auslesen von: mari
Geschrieben am: 13.01.2010 09:38:49

Hallo Franz,

supi. Vielen vielen Dank

Gruß mari


Beiträge aus den Excel-Beispielen zum Thema "Bestimmte Zeilen aus mehreren Dateien auslesen"