Syntax um mehrere Excel-Dateien auszuwerten

Aus irgendeinem mir unbekannten Grunde wurde der von mir eröffnete Thread geschlossen bzw. archiviert. Daher stelle ich meine nachfolgende Frage hier erneut, in einem neuen Thread:
Geehrte Forum-Gemeinde,
Ich wende mich bezüglich einer etwas komplizierten Anfrage an Euch. Ausserdem bin ich ein VBA-Einsteiger, möchte jedoch gerne dazulernen weil mich die (a priori noch theoretischen) Möglichkeiten faszinieren.
In einem Hauptordner existieren ca. 20 Unterordner, die allesamt an die 20-30 Excel-Dateien enthalten.
Mittels VBA sollen die diversen Excel-Dateien, die alle samt identisch aufbereitet sind (also die gleiche Struktur haben), ausgewertet werden und die Auswertungen in ein zentrales Excel-File kopiert werden.
Verschiedene Abteilungen bzw. Mitarbeiter führten Listen mit verkauften Artikeln, bereits bezahlten Artikel und wieder stornierten Artikeln. Dazu wurde eine Artikel-Nr. und eine Artikel-Bezeichnung erfasst. Diese versch. Dateien sollen nun quasi für Auswertungen, Vergleiche etc. zusammengeführt bzw. ausgewertet werden. Ausserdem will man zukünftig weg von dieser Methodik bzw. eine etwas einfachere/standardisiertere Methode wählen.
Die Dateibeschriftungen der Excel-Files sehen so aus (als Beispiel):
12_SalesReg_32_LAG.xlsx
Die Inhalte der Excel-Dateien weisen folgende Struktur auf:
In Spalte A: (+/-); In Spalte B: Zusammengesetzte Nr. oder -----; Spalce C: Artikelname & Code oder ------
Alle Produkte bezahlt
------ ------
+ 4547.7755 Artikel ABC
+ 4354.9677 Artikel XYZ
+ 3632.1254 Artikel MNO
+ 4100.0201 Artikel PQR
- 9698.3300 Artikel EFG
- 7810.2500 Artikel TUV
Alle Produkte bezahlt
------ ------
+ 4547.7755 Artikel ABC
+ 4354.9677 Artikel XYZ
- 3632.1254 Artikel MNO
- 4100.0201 Artikel PQR
- 9698.3300 Artikel EFG
- 7810.2500 Artikel TUV
+ ------ ------
+ 2705.6301 Artikel KLM
+ 5454.0004 Artikel WER
- 3201.1707 Artikel HIJ
- 6022.7405 Artikel BMN
- 9698.3300 Artikel EFG
- 7810.2500 Artikel TUV
Alle Produkte bezahlt
------ ------
+ 4547.7755 Artikel ABC
+ 4354.9677 Artikel XYZ
- 3632.1254 Artikel MNO
- 6022.7405 Artikel BMN
- 9698.3300 Artikel EFG
Alle Produkte bezahlt
Was ausgewertet werden soll:
1) Aus Dateiname; erste Zahl (zwei Stellen): 12_SalesReg_32_LAG.xls = 12
--> Ins zentrale Excel-File in die Spalte mit Bezeichnung "AbtNr"
--> Dies wollte ich über den FileDialog mit folgendem Eintrag lösen:
Debug.Print Right("ABCD", 2)
CD
2) Aus Dateiname; zweite Zahl (zwei Stellen): 12_SalesReg_32_LAG.xls = 32
--> Ins zentrale Excel-File in die Spalte mit Bezeichnung "PeriodNr"
--> Auch dies wollte ich über den FileDialog mit dem o.g. Eintrag lösen.
3) Dichotomisierte Ausgabe, beim Eintrag "Alle Produkte bezahlt": wenn "Alle Produkte bezahlt" steht = 1; Sonst = 0)
--> Ins zentrale Excel-File in die Spalte mit Bezeichnung "AllSold"
4) Auswerten ob in Spalte A (+/-) ein + oder - steht und übertrag ins zentrale Excel-File in Spalte mit Bezeichnung "+/-"
5) Erste vier Ziffern (vor dem Punkt) der Artikel-Nr. (z.b 6022.7405: "6022" davon auswerten bzw. ins zentrale Excel-File kopieren)
6) Letzten vier Ziffern (nach dem Punkt) der Artikel-Nr. (z.b 6022.7405: "7405" davon auswerten bzw. ins zentrale Excel-File kopieren)
7) Kopieren der Artikelbezeichnung ins zentrale Excel-File; z.B. Artikel ABC kopieren
Idealerweise könnte man eine VBA-Syntax auf mehrere versch. Dateien (die allesamt aber ident. strukturiert sind; selbe Spaltenpositionen, selbe Formate) anwenden und VBA wertet die gewünschten Einträge ins zentrale Excel-File aus. Ich stelle mir vor, dass ich via VBA angebe, dass er alle xlsx im besagten Haupt- bzw. Unterordner durchgeht und dabei die Syntax anwendet. Dabei würde ich pro Zeile jede einzelne Spalte durchgehen:
Dim Zeile as Integer
Do
...
Zeile = Zeile + 1
loop until ...
Mir ist aber noch nicht ganz klar, welche Befehle für die oben aufgeführten 7 Punkte überhaupt nötig wären, damit die Auswertungen auch korrekt vorgenommen und das zentrale Excel-Sheet kopiert werden.
Das zentrale Excel-File, verfügt über folgende Spaltenbeschriftungen:
AbtNr PeriodNr ArtKrzel RegNr AllSold -/+ ArtListe ArtNr ArtTitle
Ich hatte bereits versucht, dies über "SelectCase" bzw. über die "BedingteKopieZeilen()" zu lösen. Dies scheint wohl aber nicht zu funktionieren bzw. ist nicht der korrekte Weg.
Z.B.

Public Sub Zeilen2()
Dim i As Integer
Dim cell As Range
i = 1
For Each cell In Eingabe.Range("C71:C877")
If Not cell Is Nothing Then
If cell.Value > "0" Then
cell.EntireRow.Copy 'Destination:=Tabelle2.Rows(i)
Tabelle1.Cells(i, 1).PasteSpecial , Paste:=xlPasteValues
i = i + 1
End If
End If
Next cell
End Sub

Oder Ansätzen wie
If .Cells(Zeile, 3).Value = "+" Then
.Rows(Zeile).Copy Destination:=Tabelle2.Rows(n)
Leider bisher ziemlich erfolglos - Evtl. setze ich als kompletter Neuling auch völlig am falschen Ort an.
Hätte jemand von Euch nützliche Tipps bzw. geeignete Formeln um dieses Problem zu lösen?
Vielen Dank im Voraus.
Freundliche Grüße
Matthias G.
----------------------
Hallo,
nur zum ersten Teil, um die Zahlen aus dem Dateinamen auszulesen:
Sub Matthias()
Tx = Cells(12, "A")
Ta = Split(Tx, "_")
Debug.Print "AbtNr = " & Ta(0), "PeriodNr = " & Ta(2)
End Sub Im Text ober ist die Rede von "20 Unterordner mit jeweils 20-30 Dateien": die erste Aufgabe wäre eine Abfrage für die Dateinamen. Wie heißt der "Basis-Ordner", gibt es in dieser Struktur auch andere xlsx-Dateien?
mfg
----------------------
Hallo,
Herzlichen Dank für diesen ersten wertvollen Input!
Der Basis-Ordner heisst:
Datenaufbereitung
(Kann evtl. noch ändern bzw. könnte ich dann immernoch in der Syntax entspr. anpassen)
In diesem Ordner sind dann Unterordner drin, wie z.B.
01_Abteilung_1
02_Abteilung_2
etc.
In diesen Unterordnern dann jeweils xlsx-Dateien, wie z.B.:
01_SalesReg_21_LAG.xlxs
02_SalesReg_22_LAG.xlsx
03_SalesReg_23_LAG.xlsx
04_SalesReg_17_LAG.xlsx
..
.
51_SalesReg_32_LAG.xls
Alle Dateien in den Unterordnern müssten anhand der Syntax ausgewertet und die entsprechenden Werte in die zentrale Excel-Datei kopiert werden. Es sind keine anderen Dateien vorhanden, welche nicht in der Gesamtauswertung erscheinen sollen.
----------------------
Hallo,
folgender Code liest die DateiNamen und daraus abgeleitet die AbtNr und PeriodNr aus.
Da ich die Datei nicht kenne werden die Werte in die Spalten A-C geschrieben.
Der Pfad muss komplett angegeben werden, also z.B. C:\users\Matthias\Datenaufbereitung\
Sub Fen_dir()
'Pfad anpassen sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""c:\...\Datenaufbereitung\*.xls*"" _
/b/s").stdout.readall, vbCrLf)
For i = 0 To UBound(sn)
Cells(i + 1, "A") = sn(i)
Cells(i + 1, "B") = Split(sn(i), "_")(0)
Cells(i + 1, "C") = Split(sn(i), "_")(2)
Next i
End Sub mfg
(Deine anderen Fragen sollen andere beantworten)
----------------------
Hallo Matthias,
hier ein Versuch, der zeigt, wie es gehen könnte. Für die Demo habe ich die Daten in eine TXT-Datei geladen und dann importier. Dies müsste durch ein workbooks.open ersetz werden. Auch die Spalten in der Master-Datei müssen noch modifiziert werden.
https://www.herber.de/bbs/user/106105.xls
mfg
------------------------

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Matthias() Application.DisplayAlerts = False m = 1 'Zeile des Mastersheets sPath = "C:\Users\MG\Desktop\Datenaufbereitung" sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""C:\Users\MG\Desktop\Team_1 *.xls"" _ /b/s").stdout.readall, vbCrLf) For Each d In sn If Len(d) > 0 Then Tx = Split(d, "\") Ta = Split(Tx(UBound(Tx)), "_") AbtNr = Ta(0) PeriodNr = Ta(2) Debug.Print "AbtNr = " & Ta(0), "PeriodNr = " & Ta(2) With Workbooks.Open("C:\Users\MG\Desktop\Datenaufbereitung" & ""C:\Users\MG\Desktop\Team_1 * _ .xls"" ) If .Cells(1, 1) = "Alle Produkte bezahlt" Then Allsold = 1 lr = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lr If InStr(1, .Cells(i, "A"), "Artikel") > 0 Then Tx = Split(.Cells(i, "A")) With Sheets("Master") m = m + 1 .Cells(m, "A") = AbtNr .Cells(m, "B") = PeriodNr .Cells(m, "C") = Allsold For j = 0 To UBound(Tx) .Cells(m, "D").Offset(, j) = Tx(j) Next j End With End If Next i .Delete End With End If Next d Application.DisplayAlerts = True End Sub

Sub Matthias() Application.DisplayAlerts = False m = 1 'Zeile des Mastersheets sPath = "C:\Users\DD\Desktop\Datenaufbereitung\" sFile = "*.xls" ' sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""C:\Users\DD\Desktop\ _ Datenaufbereitung\Solothurn_1\*.xls"" / _ b/s").stdout.readall, vbCrLf) sn = Split(CreateObject("wscript.shell").exec("cmd /c dir " & sPath & sFile & "/b/s").stdout. _ _ readall, vbCrLf) For Each d In sn Debug.Print d If Len(d) > 0 Then Tx = Split(d, "\") Ta = Split(Tx(UBound(Tx)), "_") AbtNr = Ta(0) PeriodNr = Ta(2) Debug.Print "AbtNr = " & Ta(0), "PeriodNr = " & Ta(2) ' With Sheets.Add(, , , d) With Workbooks.Open("C:\Users\DD\Desktop\Datenaufbereitung" & d) With .Sheets(1) If .Cells(1, 1) = "Alle Produkte bezahlt" Then Allsold = 1 lr = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lr If InStr(1, .Cells(i, "A"), "Artikel") > 0 Then Tx = Split(.Cells(i, "A")) With Sheets("Master") m = m + 1 .Cells(m, "A") = AbtNr .Cells(m, "B") = PeriodNr .Cells(m, "C") = Allsold For j = 0 To UBound(Tx) .Cells(m, "D").Offset(, j) = Tx(j) Next j End With End If Next i End With '.Delete .Close 0 End With End If Next d Application.DisplayAlerts = True End Sub

Sub Matthias() Application.DisplayAlerts = False m = 1 'Zeile des Mastersheets sPath = "c:\users\dd\desktop\datenaufbereitung\" sFile = "*.xls" ' sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""c:\users\dd\desktop\ _ datenaufbereitung\*.xls"" / _ b/s").stdout.readall, vbCrLf) sn = Split(CreateObject("wscript.shell").exec("cmd /c dir " & sPath & sFile & "/b/s").stdout. _ _ readall, vbCrLf) For i = 0 To UBound(sn): Debug.Print sn(i): Next For Each d In sn Debug.Print d If Len(d) > 0 Then Tx = Split(d, "\") Ta = Split(Tx(UBound(Tx)), "_") AbtNr = Ta(0) PeriodNr = Ta(2) Debug.Print "AbtNr = " & Ta(0), "PeriodNr = " & Ta(2) ' With Sheets.Add(, , , d) With Workbooks.Open(d) With .Sheets(1) If .Cells(1, 1) = "Alle Produkte bezahlt" Then Allsold = 1 lr = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lr If InStr(1, .Cells(i, "A"), "Artikel") > 0 Then Tx = Split(.Cells(i, "A")) With Sheets("Master") m = m + 1 .Cells(m, "A") = AbtNr .Cells(m, "B") = PeriodNr .Cells(m, "C") = Allsold For j = 0 To UBound(Tx) .Cells(m, "D").Offset(, j) = Tx(j) Next j End With End If Next i End With '.Delete .Close 0 End With End If Next d Application.DisplayAlerts = True End Sub

Option Explicit Sub Matthias() Dim m As Long, i As Long, lr As Long, j As Long Dim sPath As String, sFile As String, d As Variant Dim sn As Variant, Tx As Variant, Ta As Variant Dim abtnr As Variant, periodnr As Variant, allsold As Long Dim aus0(0, 2) As Variant, aus1() As Variant ' *** neu *** ' das ist ein Array, das erst mit Werten gefüllt und ' dann komplett geschrieben wird Dim aM As Worksheet ' *** neu *** Set aM = Sheets("Master") ' Application.DisplayAlerts = False m = 1 'Zeile des Mastersheets sPath = "c:\users\dd\desktop\datenaufbereitung\" sFile = "*.xls" sn = Split(CreateObject("wscript.shell").exec("cmd /c dir " & _ sPath & sFile & "/b/s").stdout.readall, vbCrLf) For i = 0 To UBound(sn): Debug.Print sn(i): Next Stop ' stoppt die Abarbeitung des Skripts, mit F5 oder F8 geht's weiter ' An der Stelle kannst Du nachsehen, was im Debug-Fenster steht... For Each d In sn Debug.Print d Stop ' hier auch ... If Len(d) > 0 Then Tx = Split(d, "\") Ta = Split(Tx(UBound(Tx)), "_") abtnr = Ta(0) periodnr = Ta(2) aus0(0, 0) = abtnr: aus0(0, 2) = periodnr Debug.Print "AbtNr = " & Ta(0), "PeriodNr = " & Ta(2) ' und was kommt hier? Stop With Workbooks.Open(d) With .Sheets(1) ' hier stimmt die Logik nicht: ' If .Cells(1, 1) = "Alle Produkte bezahlt" Then Allsold = 1 ' Allsold bleibt auf 1, auch wenn in der nächsten Datei ' nicht alles bezahlt ist. Richtig wäre es so: If .Cells(1, 1) = "Alle Produkte bezahlt" Then _ allsold = 1 Else allsold = 0 aus0(0, 1) = allsold ' ich bevorzuge die Range-Schreibweise, außerdem hat ' der . vor rows.count gefehlt lr = .Range("A" & .Rows.Count).End(xlUp).Row For i = 2 To lr If InStr(1, .Cells(i, "A"), "Artikel") > 0 Then Tx = Split(.Cells(i, "A")) ' da frage ich mich, wie die Datei wohl aussieht! With Sheets("Master") m = m + 1 ReDim aus1(0, UBound(Tx) + 3) For j = 0 To 2: aus1(0, j) = aus0(0, j): Next For j = 0 To UBound(Tx) ' .Cells(m, "D").Offset(, j) = Tx(j) aus1(j + 3) = Tx(j) Next j .Range("A" & m).Resize(1, UBound(aus1, 2)) = aus1 End With End If Next i End With .Close 0 End With End If Next d ' Application.DisplayAlerts = True End Sub

Sub Matthias_Michael() Dim m As Long, i As Long, lr As Long, j As Long Dim sPath As String, sFile As String, d As Variant Dim sn As Variant, Tx As Variant, Ta As Variant Dim abtnr As Variant, periodnr As Variant, allsold As Long Dim aus0(0, 3) As Variant ' das ist ein Array, das erst mit Werten gefüllt und ' dann komplett geschrieben wird Dim aM As Worksheet ' *** neu *** Set aM = Sheets("Master") ' Application.DisplayAlerts = False m = 1 'Zeile des Mastersheets ' sPath = "c:\users\dd\desktop\datenaufbereitung\" sPath = "c:\A_Herber\Matthias\" sFile = "*.xls" sn = Split(CreateObject("wscript.shell").exec("cmd /c dir " & _ sPath & sFile & "/b/s").stdout.readall, vbCrLf) ' For i = 0 To UBound(sn): Debug.Print sn(i): Next Stop ' stoppt die Abarbeitung des Skripts, mit F5 oder F8 geht's weiter ' An der Stelle kannst Du nachsehen, was im Debug-Fenster steht... For Each d In sn ' Debug.Print d ' Stop ' hier auch ... If Len(d) > 0 Then Tx = Split(d, "\") Ta = Split(Tx(UBound(Tx)), "_") abtnr = Ta(0) periodnr = Ta(2) aus0(0, 0) = abtnr: aus0(0, 2) = periodnr Debug.Print "AbtNr = " & Ta(0), "PeriodNr = " & Ta(2) ' und was kommt hier? ' Stop With Workbooks.Open(d) With .Sheets(1) If .Cells(1, 1) = "Alle Produkte bezahlt" Then _ aus0(0, 1) = 1 Else aus0(0, 1) = 0 lr = .Range("A" & .Rows.Count).End(xlUp).Row ' wieso erst ab 2? In der Datei ist keine Überschrift! For i = 1 To lr If InStr(1, .Range("C" & i), "Artikel") > 0 Then ' Stop m = m + 1 aus0(0, 3) = Mid(.Range("C" & i), 9) aM.Range("A" & m).Resize(1, UBound(aus0, 2) + 1) = aus0 End If Next i End With .Close 0 End With End If Next d ' Application.DisplayAlerts = True End Sub

Hi Matthias,
vielen Dank, daß Du die "grandiose Hilfsbereitschaft" von mir (und anderen Helfern) zu schätzen weißt.
Anscheinend bezieht sich das "Alle bezahlt" immer auf einen Datenblock zwischen jeweils "---" oben und unten...
Ich habe mal das Makro so geändert, daß es in der geöffneten Datei Formeln in Spalte D schreibt (siehe Kommentare im Code), die je nach dem 0 oder 1 ergeben. Da die Datei sowieso readonly geöffnet und auch nicht gespeichert wird, ist das am einfachsten, außerdem kannst Du so selbst mit der Formel experimentieren und vielleicht noch andere Erweiterungen auf so einer Basis einbauen:

.Sheets(1).Range("D1:D" & lr).FormulaLocal = _
"=WENN(C1=""Alle Produkte bezahlt"";1;WENN(LINKS(C1;2)=""--"";0;D2))"
Stop  ' diese Zeile mit dem Stop bitte später wieder löschen...

Die "" werden als " in die Zellen geschrieben. So verwendet man " innerhalb eines Strings; z.B. kannst Du im "Direktbereich" (Strg+g in VBA) testen:

debug.Print "Dies ist ""ein"" Text."
Dies ist "ein" Text.

Datei: https://www.herber.de/bbs/user/106391.xlsm
Schöne Grüße,
Michael

Sub Matthias() Application.DisplayAlerts = False m = 1 'Zeile des Mastersheets sPath = "c:\tmp\datenaufbereitung\" sFile = "*.xls" ' sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""c:\tmp\datenaufbereitung\*.txt"" / _ b/s").stdout.readall, vbCrLf) sn = Split(CreateObject("wscript.shell").exec("cmd /c dir " & sPath & sFile & "/b/s").stdout. _ readall, vbCrLf) For Each d In sn Debug.Print d If Len(d) > 0 Then Tx = Split(d, "\") Ta = Split(Tx(UBound(Tx)), "_") AbtNr = Ta(0) PeriodNr = Ta(2) Debug.Print "AbtNr = " & Ta(0), "PeriodNr = " & Ta(2) ' With Sheets.Add(, , , d) With Workbooks.Open(d) With .Sheets(1) If .Cells(1, 1) = "Alle Produkte bezahlt" Then Allsold = 1 lr = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lr If InStr(1, .Cells(i, "A"), "Artikel") > 0 Then Tx = Split(.Cells(i, "A")) With Sheets("Master") m = m + 1 .Cells(m, "A") = AbtNr .Cells(m, "B") = PeriodNr .Cells(m, "C") = Allsold For j = 0 To UBound(Tx) .Cells(m, "D").Offset(, j) = Tx(j) Next j End With End If Next i End With '.Delete .Close 0 End With End If Next d Application.DisplayAlerts = True End Sub

Beliebteste Forumthreads (12 Monate)

Syntax um mehrere Excel-Dateien auszuwerten

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread