Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1752to1756
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

csv auslesen optimieren

csv auslesen optimieren
24.04.2020 07:20:34
Mike
Hallo zusammen,
mit dem nachfolgenden Makro lese ich nacheinander Ordnernamen ein, öffne eine csv, suche eine bestimmte Zeile, lese einen Wert aus, schließe die csv und gehe zum nächsten Ordner.
Zur Zeit befinden sich unter dem Pfad 5450 Ordner was bei meinem Makro dazu führt, dass es sehr lange dauert. Das reine einlesen der Ordnernamen geht sehr schnell und stellt nicht das Problem da.
Die reine Funktion des Makros ist also gegeben aber ich könnte mir vorstellen, dass es eine schnellere Lösung für das auslesen der Zeile innerhalb der csv gibt. Kann jemand dabei helfen?
  • 
    Sub importR()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim strPfad As String
    Dim objSubfolder As Object
    Dim colSubfolders As Object
    Dim i As Integer
    Dim wsZiel As Worksheet
    Dim wbDESC As Workbook
    Dim wsDESC As Worksheet
    Dim adrDESC As Range
    Call EventsOff
    Set wsZiel = Workbooks("Erst.xlsm").Sheets("RüstI")
    wsZiel.Range("A:F").ClearContents
    wsZiel.Range("F1") = Now
    strPfad = "Z:\Rüst\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strPfad)
    Set colSubfolders = objFolder.Subfolders
    For Each objSubfolder In colSubfolders
    i = i + 1
    wsZiel.Range("A" & i).Value = objSubfolder.Name
    'bis hier läuft alles einwandfrei und schnell. Erst das einlesen der csv bremst alles stark aus. _
    Set wbDESC = Workbooks.Open(strPfad & objSubfolder.Name & "\" & objSubfolder.Name & _
    ".desc", ReadOnly:=True)
    Set wsDESC = wbDESC.Sheets(1)
    wsDESC.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Set adrDESC = wsDESC.Range("A:A").Find("PRODUCT_CODE", LookIn:=xlValues, _
    lookat:=xlWhole)
    If Not adrDESC Is Nothing Then
    wsZiel.Range("B" & i) = adrDESC.Offset(0, 1).Value
    End If
    wbDESC.Close SaveChanges:=False
    Next objSubfolder
    Set objFolder = Nothing
    Set colSubfolders = Nothing
    Set objFSO = Nothing
    Call EventsOn
    End Sub
    

  • Über Call Events setze ich nur die DisplayAlerts, ScreenUpdating und EnableEvents auf False bzw True.
    Gruß
    Mike

    5
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: csv auslesen optimieren
    24.04.2020 08:34:09
    volti
    Hallo Mike,
    eine ungetestete Idee:

    Sub importR()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim strPfad As String
    Dim objSubfolder As Object
    Dim colSubfolders As Object
    Dim i As Integer
    Dim wsZiel As Worksheet
    Dim wbDESC As Workbook
    Dim wsDESC As Worksheet
    Dim adrDESC As Range
    Dim sData As String
    Call EventsOff
        Set wsZiel = Workbooks("Erst.xlsm").Sheets("RüstI")
        wsZiel.Range("A:F").ClearContents
    wsZiel.Range("F1") = Now
        strPfad = "Z:\Rüst\"
       
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(strPfad)
        Set colSubfolders = objFolder.Subfolders
       
        For Each objSubfolder In colSubfolders
            i = i + 1
            wsZiel.Range("A" & i).value = objSubfolder.Name
    'bis hier läuft alles einwandfrei und schnell. Erst das einlesen der csv bremst alles stark aus.
            With objSubfolder
             Close #1: Open strPfad & .Name & "\" & .Name & ".desc" For Binary As #1
             sData = Space(LOF(1)): Get #1, , sData
             Close #1
             sData = Split(sData & "PRODUCT_CODE;", "PRODUCT_CODE;")(1)
             If sData <> "" Then wsZiel.Range("B" & i) = Split(sData, ";")(0)
             End With
        Next objSubfolder
       
        Set objFolder = Nothing
        Set colSubfolders = Nothing
        Set objFSO = Nothing
       
    Call EventsOn
       
    End Sub
    viele Grüße
    Karl-Heinz

    Anzeige
    AW: csv auslesen optimieren
    24.04.2020 09:58:53
    Mike
    Hallo Karl-Heinz,
    vielen Dank für deinen Ansatz. Es läuft auf jeden Fall schonmal um einiges schneller als meine Lösung.
    Nach kleiner Anpassung bekomme ich auch eine Ausgabe ins Worksheet. Es ergeben sich aber noch Probleme die mit der Formatierung der csv zusammen hängt. Vielleicht kannst du mir dabei noch helfen.
    Die Einträge der *.desc Dateien sind durch Leerzeichen getrennt. Mal ist es nur eins und mal mehrere hintereinander. Das führt dazu, dass die Ausgabe mit vorangestellten Leerzeichen in die Zellen geschrieben werden. (" 123456"). Das wäre jetzt nicht unbedingt das Problem da ich nach dem schreiben einfach die Leerzeichen entfernen könnte aber viellicht lässt sich das in deine Lösung noch mit einbinden.
    Ein größeres Problem ist, dass es auch *PRODUCT_CODE Zeilen gibt. Das Macro findet die erste vorkommende Zeile mit "PRODUCT_CODE" und schreibt alles was danach kommt in sData.
    Da du die *.desc nicht kennst ist klar das eine Lösung ins Blaue schwierig ist. Ich habe daher nachfolgend mal den Inhalt (etwas kryptisch) einer solchen Datei eingefügt. IM unten dargestellten File müsste demnach 123456 in sData stehen.
    Ich wäre dankbar wenn du mir hier noch weiter helfen könntest.
    *---------------------------------------------------------------------
    * gargeargfar sdf 4434 / fd / sd
    KLFDPÄAJF                sd.jhzf
    KJDOASDAA                sd.erw
    KEKEKDMKSLAÖDSASDS       sd.aasd
    JFKODJFKOASÖJFDOÖ        aefefaedaer
    KJFDJASFDOÖSAIDFJDSKLFS  asd\jzdtsrgegw
    KONFIGURATION            egyfewf
    JIFDJALDJKS              yefywefdf
    JIFOHADADSFHJKLAAA       ydsfysefsyd
    *SDFDIRECTORY             \asd\srgsye
    *GLOBASDSDSD             1
    *PRODUCT_CODE             7460
    IFJEOFDOFDDS             efwefwef
    KOWDKDPSAAAA             ethrtjhr0
    JKWDADOPASDDD            0
    KLJDSASDAPSS             lhiulhlhuhlö
    PRODUCT_CODE             123456
    

    Gruß
    Mike
    Anzeige
    AW: csv auslesen optimieren
    24.04.2020 10:17:06
    Nepumuk
    Hallo Mike,
    Leerzeichen kannst du mit Trim$ entfernen. Du musst, so es sich immer um Zahlen handelt diese noch in eine Solche umwandeln.
    Range("A1").Value = CDbl(Trim$(DeineZeichenkette))
    

    Gruß
    Nepumuk
    AW: csv auslesen optimieren
    24.04.2020 10:54:56
    volti
    Hallo Mike,
    schau mal, ob dieser Code der Sache näher kommt:

    Sub importR()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim strPfad As String
    Dim objSubfolder As Object
    Dim colSubfolders As Object
    Dim i As Integer
    Dim wsZiel As Worksheet
    Dim wbDESC As Workbook
    Dim wsDESC As Worksheet
    Dim adrDESC As Range
    Dim sData As String, sSep As String
    Call EventsOff
        Set wsZiel = Workbooks("Erst.xlsm").Sheets("RüstI")
        wsZiel.Range("A:F").ClearContents
    wsZiel.Range("F1") = Now
        strPfad = "Z:\Rüst\"
       
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(strPfad)
        Set colSubfolders = objFolder.Subfolders
       
        For Each objSubfolder In colSubfolders
            i = i + 1
            wsZiel.Range("A" & i).value = objSubfolder.Name
    'bis hier läuft alles einwandfrei und schnell. Erst das einlesen der csv bremst alles stark aus.
            With objSubfolder
             Close #1: Open ThisWorkbook.Path & "\MeinTest.desc" For Binary As #1
             sData = Space(LOF(1)): Get #1, , sData
             Close #1
             sSep = vbCrLf & "PRODUCT_CODE"
             sData = Trim$(Split(sData & sSep, sSep)(1))
             If sData <> "" Then
                wsZiel.Range("B" & i) = Trim$(Split(sData & vbCrLf, vbCrLf)(0))
             End If
        Next objSubfolder
       
        Set objFolder = Nothing
        Set colSubfolders = Nothing
        Set objFSO = Nothing
       
    Call EventsOn
       
    End Sub
    viele Grüße
    Karl-Heinz

    Anzeige
    AW: csv auslesen optimieren
    24.04.2020 13:43:43
    Mike
    Hallo Karl-Heinz,
    das funktioniert super. Ich bin zwar noch nicht komplett durch deinen Code gestiegen aber das werde ich mir nochmal alles genau anschauen.
    Ich sage auf jeden Fall vielen Dank für deine Hilfe in der Sache.
    Auch an Nepumuk Danke für den Hinweis.
    Bleibt Gesund und Gruß
    Mike

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige