Makro:Aus einer CSV datei die als Matrix aufgebaut ist, Liste produzieren

Aus XIMES

Wechseln zu: Navigation, Suche

Code

   Sub TransformMatrixInList()
  
      Dim ZeileAktuellinAusgabeDatei As Long
      Dim ZeileAktuellFürLesen As Long  'Long statt Integer erlaubt grosse zahlen über 32500
      Dim ra As Range
      Dim i, j As Long
      Dim Überschrift  As String
      Dim ersterNameWB As String
      Dim str As String
      Dim result As String
      Dim header() As Variant
      Dim werte() As Variant
      Dim colNr As Long
   
        ersterNameWB = ActiveWorkbook.Name
   
        '***Anpassen Output   #1, darüber werden Dateien dann angesprochen
        Open ActiveWorkbook.Path & "\ResultFürTIS.csv" For Output As #1         'Ergebnisdatei ... Name anpassen
        Open ActiveWorkbook.Path & "\ResultFürTIS_REPORT.csv" For Output As #2  'Für Kurzbericht zu Export (Felder und Zeilen)
        Open ActiveWorkbook.Path & "\Rohdatei.txt" For Input As #3              '***Anpassen Eingabedatei
        ZeileAktuellinAusgabeDatei = 1
        
        'WICHTIG
        'Die Rohdatei
        'Die Ergebnisdateien werden in das Verzeichnis gespeichert das jenes Excel hat, das gerade aktiv ist
        ' *** aktiv ist das was am Bildschirm als EXCEl sichtbar ist ***
        'Das kann verschieden sein von jenem EXCEL-Workbook in dem das Makro steht
        'Das kann verschieden sein von jenem EXCEL-Workbook in dem Daten
         
       
       'Aufbau der Überschrift, schrittweise, damit Reihenfolge leichter verändert werden kann
       '*** Anpassen
       Überschrift = "Datum"
       Überschrift = Überschrift & Chr(9) & "Nr"
       Überschrift = Überschrift & Chr(9) & "Stunden"
   
       Print #1, Überschrift 'Druck in Ergebnisdatei
       Print #2, "Es werden Daten in folgendem Aufbau:"
       Print #2, Überschrift 'Druck in Reportdatei
       
       ZeileAktuellFürLesen = 0
       
       Line Input #3, str
       
       colNr = ZerlegeFixedLengthStringInArray(str, header)
           
       Line Input #3, str  '***ANPASSEN Überspringen einer Leerzeile
       While Not EOF(3)
           
           Line Input #3, str
           colNr = ZerlegeFixedLengthStringInArray(str, werte)
           ZeileAktuellFürLesen = ZeileAktuellFürLesen + 1
           For i = 2 To colNr
               
               '*** Anpassen
               result = Left(header(i), 6) & "20" & Mid(header(i), 7, 2)
               result = result & Chr(9) & werte(1)
               result = result & Chr(9) & Format(werte(i) / 24, "HH:mm")
               
               If werte(i) > 0 Then
                   Print #1, result
                   ZeileAktuellinAusgabeDatei = ZeileAktuellinAusgabeDatei + 1
               End If
           Next
           
       Wend
             
       Print #2, "Zeilen aus diesem Blatt gelesen: " & ZeileAktuellFürLesen; "    Zeilen aus diesem Blatt geschrieben(exkl. Header): " & ZeileAktuellinAusgabeDatei - 1
                           
        
       Close #1 'Schliessen der Ergebnisdatei
       Close #2 'Schliessen der Reportdatei
       Close #3 'Schliessen er Inputdatei
            
   End Sub

Verwendet Makros

Falls es fixed length Spalten sind:

Persönliche Werkzeuge