Daten aus Files / Ordner lesen

Selina · 2013-01-11T15:39:09+00:00

Guten Tag Ich hoffe, auch bei meinem aktuellen VBA Problem auf Eure tolle Hilfe zählen zu dürfen: In einem bestimmten Verzeichnis in C:\Temp hab ich mehrere Excel-Dateien gespeichert. Diese Dateien beinhalten alle auf dem ersten Registerblatt in der Spalte A irgendwo Nummern. Die Nummern selber stehen in den Files jeweils in Spalte A untereinander. Beispiel: im ersten File stehen in Spalte A ab der Zeile 22 total 9 Nummern untereinander. Im zweiten File stehen in der Spalte A ab der Zeile 14 total 4 Nummern untereinander. Ich suche nun eine Möglichkeit, mittels einer Makro-Schlaufe aus allen Dateien in diesem Verzeichnis alle Nummern aus den Spalten A zu lesen und diese in meiner aktuellen Arbeitsmappe (aus welcher ich das Makro starte) gesammelt (also wie eine Datensammlung) auf einem Tabellenblatt zusammenzufassen. In unserem Beispiel aus den zwei Files müsste ich nun also nach dem Makro-Durchlauf in meiner Arbeitsmappe Nun total 13 Nummern untereinander aufgelistet erhalten. Geht das irgendwie ? Bin Euch für jegliche Ratschläge und Beispiele äusserst dankbar !

Hallo Selina,
das folgende Makro ist das Grundgerüst.
ggf. muss du noch ein paar Anpassungen machen.
Gruß
Franz

'Makro erstellt unter Excel 2010
Sub Hole_Nummern_aus_Dateien()
Dim varVerzeichnis As Variant
Dim strDatei As Variant
Dim wksZiel As Worksheet
Dim wbkQuelle As Workbook, wksQuelle As Worksheet
Dim Zeile_Z As Long
Dim Zeile_Q As Long, Zeile_Q1 As Long, Zeile_Q2 As Long
Dim iCount As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis mit den Quell-Dateien auswählen"
.AllowMultiSelect = False
.InitialFileName = "C:\Temp"
If .Show = -1 Then
varVerzeichnis = .SelectedItems(1)
Else
Exit Sub
End If
End With
Set wksZiel = ActiveSheet 'Tabelle in die Nummern eingetragen werden sollen
With wksZiel
'letzte mit Dtaeneintrag in Splate A der Zieltabelle
Zeile_Z = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
strDatei = Dir(varVerzeichnis & "\*.xls*")
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Do Until strDatei = ""
iCount = iCount + 1
Application.StatusBar = "Datei-Nr. " & iCount & "  -  " & strDatei
'QuellDatei schreibgeschützt öffnen
Set wbkQuelle = Application.Workbooks.Open( _
Filename:=varVerzeichnis & "\" & strDatei, _
ReadOnly:=True)
Set wksQuelle = wbkQuelle.Worksheets(1)
With wksQuelle
'letzte Zeile in Spalte A = letzte Zeile mit einer Nummer
Zeile_Q2 = .Cells(.Rows.Count, 1).End(xlUp).Row
'1. Zeile mit einer Nummer ermitteln
Zeile_Q1 = Zeile_Q2
Zeile_Q = Zeile_Q1
'Zeilen rückwärts zählen und prüfen, ob Zelle in Spalte A nummerischen Inhalt hat
Do While IsNumeric(.Cells(Zeile_Q, 1).Text)
If Zeile_Q = 1 Then
Zeile_Q1 = 1
Exit Do
Else
Zeile_Q1 = Zeile_Q
End If
Zeile_Q = Zeile_Q - 1
Loop
'Nummern in Zieltabelle übertragen
For Zeile_Q = Zeile_Q1 To Zeile_Q2
Zeile_Z = Zeile_Z + 1
wksZiel.Cells(Zeile_Z, 1).Value = .Cells(Zeile_Q, 1).Value
Next
End With
'Quelldatei wieder schliessen
wbkQuelle.Close savechanges:=False
Set wbkQuelle = Nothing
Set wksQuelle = Nothing
strDatei = Dir
Loop
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
End With
Set wksZiel = Nothing
MsgBox "Auslesen der Daten abgeschlossen"
End Sub

Hallo Selina,
grundsätzlich kann man in allen Inhalten der Zellen in Spalte A zuerst "." durch "" ersetzen und dann die Übertragungstarten.
In der Zieldatei kann man ja das Zahlformat für die Artikelnummern in der gewünschten Form darstellen.
Gruß
Franz

'Makro erstellt unter Excel 2010
Sub Hole_Nummern_aus_Dateien()
Dim varVerzeichnis As Variant
Dim strDatei As Variant
Dim wksZiel As Worksheet
Dim wbkQuelle As Workbook, wksQuelle As Worksheet
Dim Zeile_Z As Long
Dim Zeile_Q As Long, Zeile_Q1 As Long, Zeile_Q2 As Long
Dim icount As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis mit den Quell-Dateien auswählen"
.AllowMultiSelect = False
.InitialFileName = "C:\Temp"
If .Show = -1 Then
varVerzeichnis = .SelectedItems(1)
Else
Exit Sub
End If
End With
Set wksZiel = ActiveSheet 'Tabelle in die Nummern eingetragen werden sollen
With wksZiel
'letzte mit Dtaeneintrag in Splate A der Zieltabelle
Zeile_Z = .Cells(.Rows.Count, 1).End(xlUp).Row
.Columns(1).NumberFormat = "0"".""000"".""000"
End With
strDatei = Dir(varVerzeichnis & "\*.xls*")
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Do Until strDatei = ""
icount = icount + 1
Application.StatusBar = "Datei-Nr. " & icount & "  -  " & strDatei
'QuellDatei schreibgeschützt öffnen
Set wbkQuelle = Application.Workbooks.Open( _
Filename:=varVerzeichnis & "\" & strDatei, _
ReadOnly:=True)
Set wksQuelle = wbkQuelle.Worksheets(1)
With wksQuelle
'letzte Zeile in Spalte A = letzte Zeile mit einer Nummer
Zeile_Q2 = .Cells(.Rows.Count, 1).End(xlUp).Row
'In Spalte A alle "." in den Zellinhalten durch "nichts" ersetzen
For Zeile_Q = 1 To Zeile_Q2
With .Cells(Zeile_Q, 1)
.Value = VBA.Replace(.Text, ".", "")
End With
Next Zeile_Q
'1. Zeile mit einer Nummer ermitteln
Zeile_Q1 = Zeile_Q2
Zeile_Q = Zeile_Q1
'Zeilen rückwärts zählen und prüfen, ob Zelle in Spalte A nummerischen Inhalt hat
Do While IsNumeric(.Cells(Zeile_Q, 1).Text)
If Zeile_Q = 1 Then
Zeile_Q1 = 1
Exit Do
Else
Zeile_Q1 = Zeile_Q
End If
Zeile_Q = Zeile_Q - 1
Loop
'Nummern in Zieltabelle übertragen
For Zeile_Q = Zeile_Q1 To Zeile_Q2
Zeile_Z = Zeile_Z + 1
wksZiel.Cells(Zeile_Z, 1).Value = .Cells(Zeile_Q, 1).Value
Next
End With
'Quelldatei wieder schliessen
wbkQuelle.Close savechanges:=False
Set wbkQuelle = Nothing
Set wksQuelle = Nothing
strDatei = Dir
Loop
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
End With
Set wksZiel = Nothing
MsgBox "Auslesen der Daten abgeschlossen"
End Sub

Forumthread: Daten aus Files / Ordner lesen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Daten aus Files / Ordner lesen

Forumthread: Daten aus Files / Ordner lesen

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread