Daten aus Files / Ordner lesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'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

Hallo Franz
es scheint, als ob wir nun wirklich einen grossen Schritt weitergekommen bin.
ich musste in meinem Code noch die folgende Zeile anpassen:

    Set wksQuelle = wbkQuelle.Worksheets(2)

und zwar musste hier beim Worksheet die Nummer 2 setzen. Die auszulesenden Daten sind immer auf dem 2. Tabellenblatt (das hatte ich leider bisher übersehen)
Zudem: das Tabellenblatt auf welchem die auszulesenden Nummern sind heisst in jedem File "Extern"
Leider aber gibt es einige wenige Files, bei denen genau eben dieses Tabellenblatt fehlt.
Hier sollte ich eine Möglichkeit haben, statt der Nummern - in der Ausgabezelle hinzuschreiben "Fehler" & Dateiname.
Ebenso gibt es Files, bei welchen das Tabellenblatt "Extern" zwar vorhanden ist, aber keine Nummern drauf enthalten sind.
Auch bei diesen Files sollte in der Ausgabezelle durch das Makro hingeschrieben werden: "Fehler" & Dateiname sowie "keine Nummern"
kann ich das leicht irgendwie noch ergänzen oder anpassen ?
das währe natürlich super
Selina

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus Files / Ordner lesen

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

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread