VB Makro läuft extrem langsam

  • Excel

Es gibt 8 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    VB Makro läuft extrem langsam

    Hi Zusammen,

    Ich bin neu in diesem Forum und habe auch kaum Erfahrung mit Visual Basic.

    Allerdings habe ich ein kleines Projekt vor mir und dazu ein Makro geschrieben, bzw in Kleinarbeit aus dem Internet zusammengesucht. Und siehe da es tut was ich will...allerdings so langsam das es praktisch unbrauchbar ist.

    Zum Hintergrund:
    Ich möchte Messwerte welche in einer tabstoppgetrennten txt-Datei gespeichert sind in Excel einlesen. Leider reicht die Zeilenanzahl von Excel 2013 nicht mal annähernd aus....Darum würde ich auf etwas Genauigkeit verzichten und zugleich das Messrauschen glätten indem ich immer 1000 Werte zu einem Mittelwert zusammen fasse.

    Anbei findet ihr natürlich eine Textdatei in stark reduzierter Ausführung damit ihr euch da was vorstellen könnt.

    Mein Ansatz: Ich füge 1000 Zeilen ein. Splitte die danach in die einzelnen Spalten auf und Berechne auf einem Weiteren Arbeitsblatt die Mittelwerte und wandle diese danach gleich in den Wert um damit ich die Formel nicht mehr stehen habe. Danach überschreibe ich die ersten 1000 Zeilen mit den Nächsten 1000 und so weiter und so fort....leider dauert das ganze für Messwerte welche in 2 Minuten aufgenommen wurden gut 5 Minuten...Somit habe ich das mit den 10 Minute aufwärts Messreihen gar nicht erst gestartet.

    Lösungsansatz:
    Alles unnötige an Kopier- und Schreibarbeit einsparen, sprich auslesen und splitten zugleich und die 1000 Werte temporär speichern und den Mittelwert daraus berechnen. Aber das ist für einen Neuling eine Herkulesaufgabe.....

    Ich hoffe ihr könnt mir da etwas Helfen die Sache zu beschleunigen....

    Und bitte keine Verweise auf Google. Es ist so deprimierend auf Google einen Beitrag zu finden in dem jemand genau das gleiche Problem hatte und in dem Thread dann nur auf Google verwiesen wird

    Vorab schon mal vielen Dank wenn sich jemand die Mühe macht um sich da kurz rein zu denken. Ich bin über jeden Vorschlag glücklich!

    LG
    Gigi


    PS: Das hochgeladene Makro ist praktisch ident mit meinem Fertigen, nur dass die Do While Schleife bis EOF läuft und der wert Durchscnitt aud 1000 steht

    *Topic verschoben*
    Dateien

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Marcus Gräfe“ ()

    Vorschlag:

    Visual Basic-Quellcode

    1. Option Explicit
    2. Sub LargeFileImport2()
    3. Dim Filename As String, FileNum As Integer, wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    4. Dim z As Long, k As Long, t As Long, max As Integer, ave As Integer
    5. Dim InputLine As String
    6. Dim FieldArray() As String
    7. Application.EnableEvents = False
    8. Application.Calculation = xlCalculationManual
    9. Application.ScreenUpdating = False
    10. Application.AskToUpdateLinks = False
    11. Filename = Application.GetOpenFilename("Textdateien (*.txt), *.txt")
    12. If Filename = "" Then End
    13. FileNum = FreeFile()
    14. Open Filename For Input As #FileNum
    15. Set wb = Workbooks.Add(template:=xlWorksheet)
    16. Set ws1 = wb.Sheets(1)
    17. Set ws2 = wb.Sheets.Add(After:=ws1)
    18. ws2.Cells(1, 2) = "Passivkraft"
    19. ws2.Cells(1, 3) = "Schnittkraft"
    20. ws2.Cells(1, 4) = "Vorschubkraft"
    21. max = 300
    22. ave = 100
    23. z = 1
    24. k = 0
    25. t = 2
    26. Do While z < max + 1
    27. Line Input #FileNum, InputLine
    28. FieldArray = Split(Replace(InputLine, ",", Application.DecimalSeparator), vbTab)
    29. ws1.Range(ws1.Cells(k + 1, 1), ws1.Cells(k + 1, UBound(FieldArray) + 1)).Value = FieldArray
    30. z = z + 1
    31. k = k + 1
    32. If k = ave Then
    33. ws1.UsedRange.NumberFormat = "General"
    34. ws1.UsedRange.Value = ws1.UsedRange.Value
    35. ws2.Cells(t, 2).Value = WorksheetFunction.Average(Intersect(ws1.UsedRange, ws1.Range("B:B")))
    36. ws2.Cells(t, 3).Value = WorksheetFunction.Average(Intersect(ws1.UsedRange, ws1.Range("C:C")))
    37. ws2.Cells(t, 4).Value = WorksheetFunction.Average(Intersect(ws1.UsedRange, ws1.Range("D:D")))
    38. t = t + 1
    39. k = 0
    40. End If
    41. ws1.UsedRange.EntireRow.Delete xlUp
    42. Loop
    43. Close #FileNum
    44. Application.Calculation = xlCalculationAutomatic
    45. Application.ScreenUpdating = True
    46. Application.AskToUpdateLinks = True
    47. Application.EnableEvents = True
    48. Application.StatusBar = "Fertig"
    49. End Sub
    Einige deiner Konstrukte habe ich einfach so drin gelassen, aber einige konnte ich nicht mit ansehen.

    Teste mal mit großen Datenmengen.
    Ich glaube nicht, dass es einen Unterschied macht, Calculation und Events abzuschalten, wenn du nach diesem Verfahren vorgehst.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „petaod“ ()

    Hi,

    Danke für die schnelle Antwort. Sieht auf jeden Fall wesentlich schneller aus als mein Code.

    Leider gibt er mir einen Laufzeitfehler bei Zeile 40 aus

    "Laufzeitfehler '1004'

    Die Average-Eigenschaften des Worksheet-Objektes kann nicht zugeordnet werden."

    Werde mich da morgen in deinen Code hineindenke und evtl. bekomm ich das ja noch hin...

    Vielen Dank nochmal und ich melde mich wenns funktioniert

    LG
    Gigi

    der-Gigi schrieb:

    Die Average-Eigenschaften des Worksheet-Objektes kann nicht zugeordnet werden

    Kann ich nicht nachvollziehen.
    Von wo aus führst du den Code aus? Modul oder Worksheet?

    Stehen die Werte als Text oder als Zahlen drin?
    Was passiert bei ​wb.Application.WorksheetFunction.Average(ws1.Range("B1:B100"))?
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    WOW. Also erst mal dein Code ist schnell! :D Großes Danke!

    Der Fehler war der Ausdruck "Application.DecimalSeparator" in Zeile 33. Habe durch zufall gesehen das er das nicht kapiert hat und daher die "," als 1000er Trennzeichen statt als Kommas verwendet hat. Ich habe das "Application.DecimalSeparator" durch ein "." ersetzt und jetzt tut er :D

    Allerdings wenn ich nun des "Do While z < max + 1" was nur als Begrenzung zum Testen gedacht war, auf "Do While Not EOF(FileNum)" austausche kommt leider wieder ein Fehler in der Zeile 34 "ws1.Range(ws1.Cells(k + 1, 1), ws1.Cells(k + 1, UBound(FieldArray) + 1)).Value = FieldArray"

    Laufzeitfehler 1004
    Anwendungs- oder objektdefinierter Fehler

    Hoffe du kannst mir da nochmal helfen?

    Edit:
    Mit dem kleinen Testfile funktioniert es. Erst beim Große hängt er sich auf. Was ich beobachtet habe ist das er genau bis 1000 Werte kommt (den Average Wert auf 1 gestellt und er ist in Arbeitsblatt2 bis Zeile 10 001 gekommen. Schalte ich den Averagewert auf 1000 kommt er genau noch bis Zeile 11 im und bei Ave=10000 kommt er noch bis Zeile 2 ....)
    Ich kann aber leider keines der Großen Files hochladen...das kleinste hat 142 MB und sie gehen bis 1,4 GB...

    LG
    Gigi

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „der-Gigi“ ()

    k ist dann 0

    Nein. Die Datei ist noch viel viel größer. Habs auch noch mit den noch Größeren getestet. Selbes Problem

    Edit:
    Anbei noch eine Größere Testdatei....hat schon 13 MB
    Dateien
    • Test2.txt

      (16,08 MB, 210 mal heruntergeladen, zuletzt: )
    Hi,

    Ich komme bei dem Problem einfach nicht weiter....hat hier keiner einen Lösungsvorschlag oder einen Workaround?

    Anbei nochmal das Makro und die Datei die eingelesen werden soll.

    Danke und LG
    Gigi
    Dateien
    • Test2.txt

      (16,08 MB, 189 mal heruntergeladen, zuletzt: )
    • Makro.txt

      (1,88 kB, 194 mal heruntergeladen, zuletzt: )
    Du hast halt Leerzeilen in deiner Textdatei (z.B. in Zeile 10001).
    Das musst du abfangen.
    Wenn du dich auf den Inhalt deiner Dateien nicht verlassen kannst, musst du noch wesentlich mehr Fehlerbehandlung einbauen.
    Was, wenn plötzlich nichtnumerische Werte drinstehen?

    Aber solche Dinge sind doch in 2 Minuten Debuggen erkannt.

    Visual Basic-Quellcode

    1. Do While Not EOF(FileNum)
    2. Line Input #FileNum, InputLine
    3. FieldArray = Split(Replace(InputLine, ",", "."), vbTab)
    4. If UBound(FieldArray) >= 0 Then
    5. ws1.Range(ws1.Cells(k + 1, 1), ws1.Cells(k + 1, UBound(FieldArray) + 1)).Value = FieldArray
    6. z = z + 1
    7. k = k + 1
    8. If k = ave Then
    9. ws1.UsedRange.NumberFormat = "General"
    10. ws1.UsedRange.Value = ws1.UsedRange.Value
    11. ws2.Cells(t, 2).Value = WorksheetFunction.Average(Intersect(ws1.UsedRange, ws1.Range("B:B")))
    12. ws2.Cells(t, 3).Value = WorksheetFunction.Average(Intersect(ws1.UsedRange, ws1.Range("C:C")))
    13. ws2.Cells(t, 4).Value = WorksheetFunction.Average(Intersect(ws1.UsedRange, ws1.Range("D:D")))
    14. t = t + 1
    15. k = 0
    16. End If
    17. ws1.UsedRange.EntireRow.Delete xlUp
    18. End If
    19. Loop

    Ausserdem benötigt das Script für 1,5 Mio Messwerte immer noch fast eine Minute.
    Das wäre für mich immer noch inakzeptabel.
    Da kannst du noch mindestens Faktor 10 rausholen, indem du nicht zeilenweise in das Worksheet schreibst, sondern erst mal in ein Array, das du in großen Blöcken ins Worksheet schreibst.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --