Thema Datum  Von Nutzer Rating
Antwort
Rot Bestimmte Zellen aus verschiedenen CSV-Dateien aus Unterordner auslesen
15.08.2023 08:57:37 David
NotSolved
15.08.2023 12:00:20 Gast20783
NotSolved
16.08.2023 10:22:24 Gast73646
NotSolved

Ansicht des Beitrags:
Von:
David
Datum:
15.08.2023 08:57:37
Views:
402
Rating: Antwort:
  Ja
Thema:
Bestimmte Zellen aus verschiedenen CSV-Dateien aus Unterordner auslesen

Guten Morgen zusammen,

bezüglich meinem konkreten Vorhaben, habe ich nichts genaueres im Forum gefunden und erhoffe mir hier etwas Hilfe, da ich schlichtweg seit 2 Woche nicht weiter komme.

Vorab: Würde gerne eine Tabelle und Bild hochladen zur Visualisierung, aber leider komm ich mit dem Editor hier nicht ganz zurecht. Hat jemand eine Idee wie man ein Bild bzw Tabelle hier einfügen kann?


Nun zu meiner Aufgabe. Ich bin ziemlich neu im VBA und möchte das auslesen meiner Berechnungsergebnisse automatisieren:


Ich habe einen Order in dem sämtliche CSV-Dateien mit unterschiedlichen Dateinamen abgelegt werden (automatisiert vom Berechnungsprogramm).

Die Dateien werden folgendermassen vom Berechnungsprogramm im Ordner abgelegt (zur Vereinfachung nur 2 aufgelistet):
- ABC_V1_2023-07_1641-110_B1-dq5pc_(...).csv
- ABC_V1_2023-07_1641-120_B1-dq5pc_(...).csv


In dem Beispiel ist der SimCode unterschiedliche (1641-110 und 1641-120 sowie die ausgeblendeten Streckendaten am Ende der Datei). Als Präfix zur genauen Unterscheidung der Ergebnise im Order würde ich immer den SimCode heranziehen.

Nun möchte ich zb. aus der ersten CSV-Dateien die Zelle B48; B55; B81 usw in mein Ergebnisfile welches in der Spalte F mit "+" markiert is einlesen.

Und zwar soll aus der ersten CSV Datei zb. die Zelle B48 in die Zeile mit dem SimCode 1641-110 in Zelle "R17" eingelesen werden. Zelle "B55" aus dem CSV Datei in die Zelle "S17" des Ergebnis-Files usw usw. Das soll automatisiert über einen Button (CSV-Ergebnisse importieren) passieren.

Habe bis jetzt folgenden Quellcode erstellt, der aber bis jetz nicht funktioniert. Bei der Prüfung des Verzeichnisses/Order (rot markiert) läuft der Code nicht durch:

 

Sub CSV_Importieren()                                                                                                   ' Shortcut: Ctrl+Shift+i (Extras > Makro > Makros... > Optionen ...) deaktiviert wegen evtl. Konflikt!
' Attribute CSV_Importieren.VB_ProcData.VB_Invoke_Func = "I\n14"
  ' Pfad0 = ActiveWorkbook.Path + "\"
  Application.ScreenUpdating = False
  Name0 = ActiveWorkbook.Name
  ResSheet = "SgE-Z (BOR@SIM)"
  ImpSheet = "CSV-Import"
  ModelCol_ = "X"                                                                                                       ' Modell (Pfad, SubPfad, Name)
  ModelCol = Range(ModelCol_ + "1").Column
  ImpCol_ = "Y"                                                                                                         ' Import-Auswahl ("+", "-", "")
  ImpCol = Range(ImpCol_ + "1").Column
  ResColS_ = "AR"                                                                                                       ' Beginn Ergenisse
  ResColS = Range(ResColS_ + "1").Column
  ResColSaD_ = "GJ"                                                                                                     ' Beginn Ergenisse SgE
  ResColSaD = Range(ResColSaD_ + "1").Column
  ResColE_ = "LJ"                                                                                                       ' Ende Ergenisse
  ResColE = Range(ResColE_ + "1").Column
  Pfad1 = Sheets(ResSheet).Cells(69, ModelCol) + "\" + Sheets(ResSheet).Cells(70, ModelCol) + "\output\"
  ImpRow = 71
  Columns(ResColS_ + ":" + ResColE_).Select                                                                             ' alle Ergebnisse einblenden
  Selection.EntireColumn.Hidden = False
  While Sheets(ResSheet).Cells(ImpRow, ImpCol) <> "-"
    If Sheets(ResSheet).Cells(ImpRow, ImpCol) = "+" Then
      ActModel = Sheets(ResSheet).Cells(ImpRow, ModelCol)
      ActVehicleType = Sheets(ResSheet).Cells(ImpRow, 3) + " " + Sheets(ResSheet).Cells(ImpRow, 4)
      ' --- CSV-Datei öffnen
      If Dir(Pfad1 + ActModel + ".csv") <> "" Then
        Name (Pfad1 + ActModel + ".csv") As (Pfad1 + ActModel + ".ssv")                                                 ' umbenennen (Semicolon), sonst wird CSV-Separator automatisch als "," (Comma) erkannt
      End If
      Workbooks.OpenText Filename:=Pfad1 + ActModel + ".ssv", Origin:=xlWindows, StartRow:=1, _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
      Name1 = ActiveWorkbook.Name
      ' --- Werte aus CSV-Datei kopieren und in ImpSheet einfügen
      Cells.Select
      Selection.Copy
      Windows(Name0).Activate
      Sheets(ImpSheet).Select
      Range("A1").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      ' --- Werte aus Zeilen "Verknüpfung zu CSV-Import" kopieren, Einfügezeile suchen und einfügen
      Sheets(ResSheet).Select
      Select Case ActVehicleType
        Case "STAG TL V1"
          Range(ResColS_ + "203:" + ResColE_ + "203").Select
        Case "STAG TW V1"
          Range(ResColS_ + "205:" + ResColE_ + "205").Select
        Case "STAG GTW V3"
          Range(ResColS_ + "207:" + ResColE_ + "207").Select
        Case "STAG GTZ V3"
          Range(ResColS_ + "209:" + ResColE_ + "209").Select
        Case "STAG FLIRT V2"
          Range(ResColS_ + "211:" + ResColE_ + "211").Select
        Case "STAG FLIRT V3"
          Range(ResColS_ + "213:" + ResColE_ + "213").Select
      End Select
      Application.CutCopyMode = False
      Selection.Copy
      Sheets(ResSheet).Cells(ImpRow, ResColS).Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      ' CSV-Datei schliessen
      Windows(Name1).Activate
      ActiveWorkbook.Close
      If Dir(Pfad1 + ActModel + ".ssv") <> "" Then
        Name (Pfad1 + ActModel + ".ssv") As (Pfad1 + ActModel + ".csv")                                                 ' rückbenennen
      End If
      Windows(Name0).Activate
    End If
    ImpRow = ImpRow + 1
  Wend
  ' --- Importdatum einfügen
  Range(ImpCol_ + "67").Select
  ActiveCell.FormulaR1C1 = "=TODAY()"
  Range(ImpCol_ + "67").Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  ' --- Seite normalisieren
  ' Columns("C:F").Select                                                                                               ' "Projekt" ausblenden
  ' Selection.EntireColumn.Hidden = True
  ' Columns("G:W").Select                                                                                               ' "Szenario-Parameter" ausblenden
  ' Selection.EntireColumn.Hidden = True
  ' Columns("Z:AK").Select                                                                                              ' "Basis-Parameter" ausblenden
  ' Selection.EntireColumn.Hidden = True
  ' Columns("CJ:CR").Select                                                                                             ' Ergebnisse "dmuz.qst" ausblenden
  ' Selection.EntireColumn.Hidden = True
  ' Columns("KI:LG").Select                                                                                             ' Ergebnisse "SQ.qst" + "SR.qst" ausblenden
  ' Selection.EntireColumn.Hidden = True
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
  Range(ResColS_ + "7").Select
  ActiveWindow.FreezePanes = False
  ActiveWindow.FreezePanes = True
  ActiveWindow.SmallScroll Down:=50
  Application.ScreenUpdating = True
  Range(ResColSaD_ + "5").Select

End Sub

Ich hoffe ich habe mich verständlich ausgedrückt.  Vielleicht hat jemand eine einfachere Lösung bzw. Idee wo der Fehler liegt.

Besten Dank vorab für die Unterstützung und Hilfe

Liebe Grüsse
David


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Bestimmte Zellen aus verschiedenen CSV-Dateien aus Unterordner auslesen
15.08.2023 08:57:37 David
NotSolved
15.08.2023 12:00:20 Gast20783
NotSolved
16.08.2023 10:22:24 Gast73646
NotSolved