Office: Verarbeitung aller Dateien in einem Ordner

Guten Tag zusammen,

habe (oh Wunder) ein "kleines" Problem mit Excel und da wurde mir dieses Forum empfohlen.

Bevor ich zur Frage komme etwas Hintergrundinformationen:

In unserem System soll monatlich über ein DOS-Skript Informationen von allen Stationen gesammelt und anschließend für jede Station eine .csv mit den gesammelten Daten erstellt werden.
Dieses Skript erstellt dann jeden Monat auch einen neuen Ordner, in dem die .csv-Dateien dann abgelegt werden.

Der Plan ist der, dass wenn die Auswertungsdatei fertig ist, sie einmal abzulegen und durch das Skript in den neu angelegten Ordner mit reinzukopieren und einfach einmal auszuführen, damit die gesammelten Daten zusammengefasst werden.

Nun zum eigentlichen Problem:
Durch o.g. Skript werden etwa 100 .csv-Dateien erstellt.
Da ich mit Excel jetzt nicht gerade ein Profi bin, dachte ich einfach, ich schreib halt einmal händisch alle Stationen rein,die abgefragt werden und auch die Formel, dass von den jeweils 10 rows in den 4 columns das Mittel errechnet wird.
Die Formeln wollte ich dann kopieren, einfach die Zahlen (statt FCS0107 dann FCS0109/FCS0213/und so ähnlich) und gut ist.
Das Ganze hab ich dann gespeichert, alle Excel-Dateien geschlossen und die Auswertung wieder geöffnet.
Nun meckert er aber, dass um die Formel zu updaten, die anderen Dateien auch auf sein müssen. Zusätzlich ist mir aufgefallen, dass bei der Formel ja dann der direkte Pfad (hier G:\....) mit drin steht.
Da ich diese Datei aber nun immer in die neuen Ordner kopieren will, würde er ja immer auf die alten Dateien zugreifen.

Ich denke mal, irgendwie wird man doch bestimmt etwas über Makros machen können ... Problem dabei ist nur - ich kann es nicht :-?

Daher meine Frage, könnte jemand von euch da etwas basteln ?
Anforderungen an dieses Makro wären (angelehnt an die angehängte Auswertung.xls):
- Er schaut in alle .csv-Dateien, die im gleichen Ordner sind
- Er schreibt den Datei-Namen in Zeile A (ob da nun FCS0107 mit oder ohne .csv steht ist total egal)
- Aus der jeweiligen .csv Datei wird der Mittelwert der Zeilen B3:B12, C3:C12, D3:12 und E3:E12 errechnet und die Mittelwerte halt in B-E neben den Dateinamen in A gesetzt.

Falls das möglich wär oder es irgendwie anders gelöst werden könnte, wäre ich für jede Hilfe dankbar :-)

Viele Grüße,
Ralf

 

Nach längerem Google abklappern hab ich zumindest schon etwas gefunden, dass alle .csv-Dateien in ein Workbook schreiben würde.

http://www.wer-weiss-was.de/theme156/article3469653.html

Den Code habe ich leicht abgeändert (u.a. die Formatierung etc. rausgenommen), sieht nun so aus:

Code:

Sub CSV()
' Erstellt unter EXCEL97
' Import mehrerer CSV-Dateien in eine EXCEL-Arbeitsmappe
  Dim wbCSV As Workbook, wbDatei As Workbook, Blattname As String
  Dim strPath As String, BoxTitel As String, BoxPrompt As String
  Dim strFilename As String, NameAnfang As String, i As Integer
  
  
  BoxTitel = "CSV-Dateien laden"
  strPath = InputBox("Pfad der CSV-Dateien", BoxTitel, "C:\Test\Untertest")
  If strPath = "" Then Exit Sub
  
  NameAnfang = InputBox("Anfang der gesuchten CSV-Dateinamen:", BoxTitel)
  If NameAnfang = "" Then Exit Sub
  
  BoxPrompt = "CSV-Dateien in neue Mappe laden?" & vbLf & vbLf
  BoxPrompt = BoxPrompt & " Bei 'Nein' kann eine vorhandene Datei geöffnet werden."
  If MsgBox(BoxPrompt, vbYesNo + vbQuestion, BoxTitel) = vbYes Then
    Workbooks.Add Template:="Workbook"
  Else
    'Vorhandene Datei öffnen
    If Application.Dialogs(xlDialogOpen).Show = False Then Exit Sub
  End If
  Set wbDatei = ActiveWorkbook
  
  'CSV-Dateien laden
  strFilename = Dir(strPath & "\" & NameAnfang & "*.csv", vbNormal)
  Do Until strFilename = ""
    Application.Workbooks.OpenText strFilename, , , , , , , Semicolon:=False, Comma:=False
    Set wbCSV = ActiveWorkbook
    Blattname = wbCSV.Sheets(1).Name
    
    'Prüfen ob gleicher Blattname schon vorhanden und ggf. ersetzen
    For i = 1 To wbDatei.Sheets.Count
      If wbDatei.Sheets(i).Name = Blattname Then
        wbDatei.Sheets(i).Delete
        wbCSV.Sheets(1).Copy before:=wbDatei.Sheets(i)
        GoTo weiter1
      End If
    Next
    
    ' CSV-Tabellenblatt an 1. Position einfügen
    wbCSV.Sheets(1).Copy before:=wbDatei.Sheets(1)
weiter1:
    wbCSV.Close False
    strFilename = Dir
  Loop
  
    Sheets.Add
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Auswertung"
  
End Sub

Wenn ich das Macro starte, gebe ich dann meinen Pfad an, im nächsten Fenster FCS und dann gehts los.
Jedoch bringt er

Wenn ich wie im Link von wer-weiss-was in der zweiten Antwort geschrieben das

Code:

strFilename = Dir(strPath & "\" & NameAnfang & "*.csv",vbNormal)

in

Code:

strFilename = strPath & "\" & NameAnfang & "*.csv"

ändere, meckert er ja (zu recht) das

Code:

strFilename = Dir

am Ende des Loops an, führt es aber zumindest schon ein mal aus und kopiert den Inhalt von FCS0107.csv in ein eigenes Sheet in einem neuen Workbook.

Kann mir da wer mit dem Code weiter auf die Sprünge helfen ?

Wenn ihr es mit mehreren testen wollt, ladet euch einfach die FCS0107.xls aus dem ersten Beitrag, nennt es in FCS0107.csv und kopiert es ein paar mal mit anderen Namen (FCS0108.csv, FCS0109.csv, usw ...).

 

Hallo!

In der beiliegenden Excel-Datei habe ich Dein Makro an mehreren Stellen zwischen den beiden waagrechten Kommentarstrichen geändert:

1) Vor der "Do Until"-Schleife habe ich Dir folgende Zeile eingefügt:

Code:

    strFilename = Dir(strFilename, vbNormal)

Damit die "Dir"-Funktion verwendet werden kann, muss sie 1x mit voller Vorbesetzung aufgerufen werden, damit die Funktion weiß, wo und nach was sie künftig suchen soll. Diese Einstellungen merkt sie sich, sodass sie am Schleifenende vor dem "Loop" ohne weitere Paramater verwendet werden kann, damit sie den nächsten Dateinamen, der dem Vorbesetzungsmuster entspricht, findet.

2) Die "OpenText"-Methode der Workbooks-Auflistung habe ich geändert:

Code:

      Workbooks.OpenText Filename:=strFilename, Semicolon:=False, Comma:=False

Diese Stelle dürfte bei Dir den 1004er-Fehler verursacht haben. Du verwendest 3 Aufrufparameter, wobei Du den 1. Parameter (strFilename) als Positionsparameter (also ohne den Namen 'Filename:=') verwendet hast, die beiden anderen (Semicolon, Comma) jedoch als benannte Parameter. Diese beiden Aufrufarten darf man niemals mischen, man muss sich jeweils für eine entscheiden.

3) Im Bereich der FOR-Schleife habe ich den unschönen Direkt-Sprung aus der Schleife entfernt. Dafür habe ich die INTEGER-Variable iPos eingesetzt zusammen mit einer "EXIT FOR"-Anweisung. Diese Anweisung ermöglicht ein korrektes Verlassen der FOR-Schleife im Gegensatz zu einem GOTO-Befehl (der Stapel, der bei einer FOR-Schleife aufgebaut wird, wird mit einem "EXIT FOR" bzw. "NEXT" wieder korrekt abgebaut).

4) Den Abschnitt zwischen den beiden waagrechten Strichen habe ich etwas vereinfacht, indem ich einen 'WITH wbDatei'.... 'END WITH'-Anweisungsblock eingesetzt habe. Dadurch braucht man innerhalb dieses Blockes statt 'wbDatei' nur '.' schreiben.

Zum Schluss: Den Code habe ich nur soweit getestet, dass er fehlerfrei compiliert wird. Ich habe ihn nicht getest, ob er inhaltlich korrekt ausgeführt wird. Insbesondere habe ich die Parameter der OPENTEXT-Methode nicht verändert.
Zu Beginn habe ich noch eine 'OPTION EXPLICIT'-Anweisung eingefügt (sollte man immer verwenden!!) und ferner bei den DIMs eine 'DIM iPos AS INTEGER'-Deklaration.

 

Hallo Exl,

vielen Dank,dass du dir die Zeit genommen hast !

Das kuriose ist, wenn man im Dialog auswählt, dass er es in eine neue Mappe legen soll, bringt er noch immer den 1004er Runtime-Error.
Und der Debugger meckert folgende Zeile an

Code:

Workbooks.OpenText Filename:=strFilename, Semicolon:=False, Comma:=False

Wenn man ihm aber eine Datei vorgibt, geht es.
Und wenn es so einmal ging, geht es danach auch mit der Methode, dass er eine neue Mappe anlegt.

Ich hab das ganze jetzt aber umgangen, indem ich gar keine Auswahl mehr anbiete, sondern den Benutzer zwinge, eine vorhandene Datei auszuwählen.
So funktioniert das Ganze nun.

Hier der Code, falls mal jemand über Google auf den Beitrag stößt und es für sich nutzen möchte ^^

Code:

Option Explicit

Sub CSV()
' Erstellt mit Excel 2003
' Import mehrerer CSV-Dateien in eine EXCEL-Arbeitsmappe
  Dim wbCSV As Workbook, wbDatei As Workbook, Blattname As String
  Dim strPath As String, BoxTitel As String, BoxPrompt As String
  Dim strFilename As String, NameAnfang As String, i As Integer
  Dim iPos As Integer
  
  
  BoxTitel = "CSV-Dateien laden"
  strPath = InputBox("Pfad der CSV-Dateien", BoxTitel, "C:\Test\Untertest")
  If strPath = "" Then Exit Sub
  
  NameAnfang = InputBox("Anfang der gesuchten CSV-Dateinamen:", BoxTitel)
  If NameAnfang = "" Then Exit Sub
  
  BoxPrompt = "Ziel-Datei auswaehlen."
  If MsgBox(BoxPrompt, vbOKOnly, BoxTitel) = vbOK Then
    'Vorhandene Datei öffnen
  If Application.Dialogs(xlDialogOpen).Show = False Then Exit Sub
  End If
' --------------------------------
  Set wbDatei = ActiveWorkbook
  With wbDatei
    'CSV-Dateien laden
    strFilename = strPath & "\" & NameAnfang & "*.csv"
    'Die DIR(..)-Funktion muss mit Pfad und Matchcode für Dateinamen vorbesetzt werden:
    strFilename = Dir(strFilename, vbNormal)
    Do Until strFilename = ""
      'Entweder Positionsparameter oder Benannte Parameter verwenden,
      'jedoch beide niemals mischen!!!
      Workbooks.OpenText Filename:=strFilename, Semicolon:=False, Comma:=False
      Set wbCSV = ActiveWorkbook
      Blattname = wbCSV.Sheets(1).Name
      
      'Prüfen ob gleicher Blattname schon vorhanden und ggf. ersetzen
      iPos = 1
      For i = 1 To .Sheets.Count
        If .Sheets(i).Name = Blattname Then
          .Sheets(i).Delete
          iPos = i: Exit For
        End If
      Next
      
      ' CSV-Tabellenblatt an iPos. Position einfügen
      wbCSV.Sheets(1).Copy before:=.Sheets(iPos)
      wbCSV.Close SaveChanges:=False
      'Nächster Dateiname auf Basis der Vorbesetzung:
      strFilename = Dir
    Loop
  End With
' ------------------------------
    Sheets.Add
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Auswertung"
  
End Sub

Dann gehts nun an das Makro, womit die Average-Werte aller Sheets zusammengesammelt werden :D

Und Danke nochmal :)

 

Ich würde dir gerne bei dem Problem helfen, nur kann ich - evtl. aufgrund meines "frischen Accounts" - die Dateien nicht öffnen.
Muss das irgendwie noch aktiviert werden?
Und auf http://www.Provider-internet-vergleich.net wirst du sicher auch fündig.

 

Danke für das Angebot, hat sich bei mir inzwischen aber erledigt.
Makro ist fertig und funktioniert.

Warum du die Dateien nicht öffnen kannst, kann ich dir leider nicht sagen.

Für alle die es interessiert, hier der komplette Code:

Code:

Option Explicit

Sub CSV()
' Erstellt mit Excel 2003
' Import mehrerer CSV-Dateien in eine EXCEL-Arbeitsmappe
  Dim wbCSV As Workbook, wbDatei As Workbook, Blattname As String
  Dim strPath As String, BoxTitel As String, BoxPrompt As String
  Dim strFilename As String, NameAnfang As String, i As Integer
  Dim iPos As Integer, j As Integer
  Dim Datensatz(3 To 13, 1 To 4) As Single
  
  BoxTitel = "CSV-Dateien laden"
  strPath = InputBox("Pfad der CSV-Dateien", BoxTitel, "C:\Test\Untertest")
  If strPath = "" Then Exit Sub
  
' ------------------------------------
' Option entfernt, da Name der zu importierenden CSV-Dateien immer mit FCS anfängt
'  NameAnfang = InputBox("Anfang der gesuchten CSV-Dateinamen:", BoxTitel)
'  If NameAnfang = "" Then Exit Sub
' ------------------------------------

  BoxPrompt = "  Ziel-Datei auswaehlen.  "
  If MsgBox(BoxPrompt, vbOKOnly, BoxTitel) = vbOK Then
    'Vorhandene Datei öffnen
  If Application.Dialogs(xlDialogOpen).Show(strPath) = False Then Exit Sub
  End If

  Set wbDatei = ActiveWorkbook
  With wbDatei
    'CSV-Dateien laden
    strFilename = strPath & "\" & "FCS" & "*.csv" ' Um Dateinamen wieder angeben zu können, obere Funktion aktivieren und "FCS" mit NameAnfang ersetzen
    strFilename = Dir(strFilename, vbNormal)
    Do Until strFilename = ""

      Workbooks.OpenText Filename:=strFilename, Semicolon:=False, Comma:=False
      Set wbCSV = ActiveWorkbook
      Blattname = wbCSV.Sheets(1).Name
      
      'Prüfen ob gleicher Blattname schon vorhanden und ggf. ersetzen
      iPos = 1
      For i = 1 To .Sheets.Count
        If .Sheets(i).Name = Blattname Then
          .Sheets(i).Delete
          iPos = i: Exit For
        End If
      Next
      
      ' CSV-Tabellenblatt an iPos. Position einfügen
      wbCSV.Sheets(1).Copy before:=.Sheets(iPos)
      wbCSV.Close SaveChanges:=False
      'Nächster Dateiname auf Basis der Vorbesetzung:
      strFilename = Dir
    Loop
  End With

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sheets(1).Select
Sheets.Add
Sheets(1).Name = "Auswertung"
wbDatei.Sheets("Auswertung").Range("A" & 1).Value = "FCS Number"
wbDatei.Sheets("Auswertung").Range("B" & 1).Value = "Avg PR"
wbDatei.Sheets("Auswertung").Range("C" & 1).Value = "Avg CN"
wbDatei.Sheets("Auswertung").Range("D" & 1).Value = "Avg CD"
wbDatei.Sheets("Auswertung").Range("E" & 1).Value = "Avg ALL"

For i = 1 To wbDatei.Sheets.Count
   If InStr(wbDatei.Sheets(i).Name, "FCS") Then
      wbDatei.Sheets("Auswertung").Range("A" & i).Value = wbDatei.Sheets(i).Name
      For j = 3 To 12
          Datensatz(j, 1) = wbDatei.Sheets(i).Range("B" & j).Value
          Datensatz(j, 2) = wbDatei.Sheets(i).Range("C" & j).Value
          Datensatz(j, 3) = wbDatei.Sheets(i).Range("D" & j).Value
          Datensatz(j, 4) = wbDatei.Sheets(i).Range("E" & j).Value
      Next j
      Datensatz(13, 1) = (Datensatz(3, 1) + Datensatz(4, 1) + Datensatz(5, 1) + _
                         Datensatz(6, 1) + Datensatz(7, 1) + Datensatz(8, 1) + _
                         Datensatz(9, 1) + Datensatz(10, 1) + Datensatz(11, 1) + _
                         Datensatz(12, 1)) / 10

      Datensatz(13, 2) = (Datensatz(3, 2) + Datensatz(4, 2) + Datensatz(5, 2) + _
                         Datensatz(6, 2) + Datensatz(7, 2) + Datensatz(8, 2) + _
                         Datensatz(9, 2) + Datensatz(10, 2) + Datensatz(11, 2) + _
                         Datensatz(12, 2)) / 10

      Datensatz(13, 3) = (Datensatz(3, 3) + Datensatz(4, 3) + Datensatz(5, 3) + _
                         Datensatz(6, 3) + Datensatz(7, 3) + Datensatz(8, 3) + _
                         Datensatz(9, 3) + Datensatz(10, 3) + Datensatz(11, 3) + _
                         Datensatz(12, 3)) / 10

      Datensatz(13, 4) = (Datensatz(3, 4) + Datensatz(4, 4) + Datensatz(5, 4) + _
                         Datensatz(6, 4) + Datensatz(7, 4) + Datensatz(8, 4) + _
                         Datensatz(9, 4) + Datensatz(10, 4) + Datensatz(11, 4) + _
                         Datensatz(12, 4)) / 10

                         wbDatei.Sheets("Auswertung").Range("B" & i).Value = Datensatz(13, 1)
                         wbDatei.Sheets("Auswertung").Range("C" & i).Value = Datensatz(13, 2)
                         wbDatei.Sheets("Auswertung").Range("D" & i).Value = Datensatz(13, 3)
                         wbDatei.Sheets("Auswertung").Range("E" & i).Value = Datensatz(13, 4)

   
   End If
 

Next i

' wbDatei.Close

End Sub

 

Probier es bitte nochmal.

Gruß
Michael