zu langsam :S

  • Excel

Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von Lightsource.

    zu langsam :S

    Hallo Leute

    Ich habe heute den Auftrag erhalten, ein Programm so umzustellen, dass es schneller ist...
    Das Programm Kopiert Atribute einer Excel-Datein und kopiert sie in eine andere. Dort werden die Atribute geprüft und je nach dem verändert.



    Seht es euch an:

    Function aufblasen()
    On Error GoTo PROC_ERR

    Dim iPasteZeile As Long
    Dim iPasteSpalte As Long

    Dim i As Long
    Dim i2 As Long

    Dim iSpalte As Long

    Dim iCopyZeile As Long
    Dim iCopySpalte As Long

    Dim iCopyInfoZeile As Long
    Dim iCopyInfoSpalte As Long

    Dim arrCopy() As String
    Dim strCopy As String

    Dim arrCopy1() As String
    Dim strCopy1 As String
    Dim CBKMCC As String
    Dim CBKCARDPROD As String
    Dim CBKCLRREG As String
    Dim CURR_SOLL As String
    Dim CBKcnt As Long


    '1ster Teil machen

    iCopyZeile = 2
    iPasteZeile = 2
    CBKcnt = 1


    Do Until iCopyZeile > 119
    'zeile auslesen
    Sheets("zfigl_t30_04_05_2011").Select

    iCopySpalte = 1
    Do Until iCopySpalte > 18
    strCopy = strCopy & Cells(iCopyZeile, iCopySpalte) & ";"
    iCopySpalte = iCopySpalte + 1
    Loop
    arrCopy = Split(strCopy, ";")
    strCopy = ""

    i = 1
    Select Case arrCopy(6)
    Case "MI* (1)"
    i2 = 3712
    Case "MI1"
    i2 = 4096
    Case Else
    i2 = 360
    End Select

    'zeile Xmal schreiben
    i = 1
    Do Until i > i2
    Sheets("WIRECARD").Select
    iPasteSpalte = 1
    Do Until iPasteSpalte > 19
    Cells(iPasteZeile, iPasteSpalte) = arrCopy(iPasteSpalte - 1)
    iPasteSpalte = iPasteSpalte + 1
    Loop
    Cells(iPasteZeile, 1) = "002"
    Cells(iPasteZeile, 17) = "6004"
    Select Case arrCopy(6)
    Case "MI* (1)"
    Sheets("MASTERFEE").Select
    CBKMCC = Cells(CBKcnt, 8)
    CBKCARDPROD = Cells(CBKcnt, 9)
    CBKCLRREG = Cells(CBKcnt, 10)
    CURR_SOLL = Cells(CBKcnt, 11)
    Sheets("WIRECARD").Select
    Cells(iPasteZeile, 8) = CBKMCC
    Cells(iPasteZeile, 9) = CBKCARDPROD
    Cells(iPasteZeile, 10) = CBKCLRREG
    Cells(iPasteZeile, 13) = CURR_SOLL
    Case "MI1"
    Sheets("VISAFEE").Select
    CBKMCC = Cells(CBKcnt, 8)
    CBKCARDPROD = Cells(CBKcnt, 9)
    CBKCLRREG = Cells(CBKcnt, 10)
    CURR_SOLL = Cells(CBKcnt, 11)
    Sheets("WIRECARD").Select
    Cells(iPasteZeile, 8) = CBKMCC
    Cells(iPasteZeile, 9) = CBKCARDPROD
    Cells(iPasteZeile, 10) = CBKCLRREG
    Cells(iPasteZeile, 13) = CURR_SOLL
    Case Else
    Select Case arrCopy(4)
    Case "M"
    Sheets("NORMALMASTER").Select
    CBKMCC = Cells(CBKcnt, 8)
    CBKCARDPROD = Cells(CBKcnt, 9)
    CBKCLRREG = Cells(CBKcnt, 10)
    CURR_SOLL = Cells(CBKcnt, 11)
    Sheets("WIRECARD").Select
    Cells(iPasteZeile, 8) = CBKMCC
    Cells(iPasteZeile, 9) = CBKCARDPROD
    Cells(iPasteZeile, 10) = CBKCLRREG
    Cells(iPasteZeile, 13) = CURR_SOLL
    Case Else
    Sheets("NORMALVISA").Select
    CBKMCC = Cells(CBKcnt, 8)
    CBKCARDPROD = Cells(CBKcnt, 9)
    CBKCLRREG = Cells(CBKcnt, 10)
    CURR_SOLL = Cells(CBKcnt, 11)
    Sheets("WIRECARD").Select
    Cells(iPasteZeile, 8) = CBKMCC
    Cells(iPasteZeile, 9) = CBKCARDPROD
    Cells(iPasteZeile, 10) = CBKCLRREG
    Cells(iPasteZeile, 13) = CURR_SOLL
    End Select
    End Select

    Select Case arrCopy(3)
    Case "9000"
    If CBKCLRREG = "1" Or CBKCLRREG = "" Then
    Cells(iPasteZeile, 14) = "441500"
    End If
    Case "9100"
    If CBKCLRREG = "1" Or CBKCLRREG = "" Then
    Cells(iPasteZeile, 12) = "441500"
    End If
    End Select

    Select Case Cells(iPasteZeile, 12)
    Case "124180"
    Cells(iPasteZeile, 12) = "0124180" & CURR_SOLL
    Case "124170"
    Cells(iPasteZeile, 12) = "0124170" & CURR_SOLL
    Case "441500"
    Cells(iPasteZeile, 12) = "0441500" & CURR_SOLL
    Case "441390"
    Cells(iPasteZeile, 12) = "0441390" & CURR_SOLL
    End Select

    Select Case Cells(iPasteZeile, 14)
    Case "124180"
    Cells(iPasteZeile, 14) = "0124180" & CURR_SOLL
    Case "124170"
    Cells(iPasteZeile, 14) = "0124170" & CURR_SOLL
    Case "441500"
    Cells(iPasteZeile, 14) = "0441500" & CURR_SOLL
    Case "441390"
    Cells(iPasteZeile, 14) = "0441390" & CURR_SOLL
    End Select



    If arrCopy(14) = "9902" Then
    If CBKCARDPROD = "" Then
    If arrCopy(4) = "M" Then
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 15) = "0000400021"
    Else
    Cells(iPasteZeile, 15) = "0000400020"
    End If

    Else
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 15) = "0000400031"
    Else
    Cells(iPasteZeile, 15) = "0000400030"
    End If
    End If
    ElseIf CBKCARDPROD = "V" Then
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 15) = "0000400041"
    Else
    Cells(iPasteZeile, 15) = "0000400040"
    End If
    ElseIf CBKCARDPROD = "MSI" Then
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 15) = "0000400011"
    Else
    Cells(iPasteZeile, 15) = "0000400010"
    End If
    End If

    ElseIf arrCopy(15) = "9902" Then
    If CBKCARDPROD = "" Then
    If arrCopy(4) = "M" Then
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 16) = "0000400021"
    Else
    Cells(iPasteZeile, 16) = "0000400020"
    End If
    Else
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 16) = "0000400031"
    Else
    Cells(iPasteZeile, 16) = "0000400030"
    End If
    End If

    ElseIf CBKCARDPROD = "V" Then
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 16) = "0000400041"
    Else
    Cells(iPasteZeile, 16) = "0000400040"
    End If
    ElseIf CBKCARDPROD = "MSI" Then
    If CBKCLRREG = "2" Or CBKCLRREG = "3" Then
    Cells(iPasteZeile, 16) = "0000400011"
    Else
    Cells(iPasteZeile, 16) = "0000400010"
    End If
    End If
    End If

    If Cells(iPasteZeile, 7) = "Blank" Then
    Cells(iPasteZeile, 7) = ""
    ElseIf Cells(iPasteZeile, 7) = "MI* (1)" Then
    Cells(iPasteZeile, 7) = "MI"
    End If

    If Cells(iPasteZeile, 4) = "Blank" Then
    Cells(iPasteZeile, 4) = "Default"
    End If


    iPasteZeile = iPasteZeile + 1
    i = i + 1
    CBKcnt = CBKcnt + 1
    Loop
    CBKcnt = 1
    iCopyZeile = iCopyZeile + 1
    Loop

    PROC_END:
    MsgBox "fertig"
    Exit Function

    PROC_ERR:



    Ich hoffe Ihr könnt mir helfen :)

    Dein Code behandelt jede Zelle einzeln und das mehrfach. Du solltest das Teil neu schreiben. Da dein Code ohnehin lauter konstante Zellbereiche enthält kannst du es mit dem Makrorecorder aufzeichnen, während du einmal das Ganze manuell machst. Danach packst du es bei abblasen an die richtige Stelle und es läuft wahrscheinlich in einer Sekunde.

    Visual Basic-Quellcode

    1. Sub abblasen()
    2. 'Datenquelle 1:1 kopieren in temporäres Arbeitblatt
    3. 'Datenquelle sortieren
    4. 'Daten ergänzen per Formel und durch deren Werte ersetzen oder durch suchen und ersetzen
    5. 'in die jeweiligen Zielbereiche schreiben und temporäres Arbeitblatt löschen
    6. End Sub

    Über den Code lasse ich mich lieber nicht aus.
    Aber bei so zusammengeklicktem Code gibt es ein Schnellverfahren zur Beschleunigung:

    Visual Basic-Quellcode

    1. Application.ScreenUpdating = False
    2. ' dann den ganzen Code
    3. Application.ScreenUpdating = True


    Wenn du's sauber machen willst, versuch zu verstehen, was der Code macht und programmier's neu.
    Die ganzen SELECTs sind tödlich.
    Erstelle für die Sheets zwei Objektvariablen und adressiere die Zellen darüber.
    Ausserdem weist man einen Wert nicht dem Range-Objekt zu sondern einer der Eigenschaften

    Visual Basic-Quellcode

    1. Set shWireCard=Sheets("WIRECARD") 'muss nur einmal zugewiesen werden
    2. shWirecard.Cells.(CBKcnt, 8).Formula = arrCopy(iPasteSpalte - 1)
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Zusätzlich zu den anderen Antworten.
    Du verwendest z.B. eine Do Until Schleife deren Endwert du mit I2 in einem Select Case vorgibst.
    Ich habe jetzt noch nicht alles genau durchgelesen (hättest besser den Text in VB Tags gesetzt),
    aber versuche mal For Next Schleifen zu verwenden, wenn du bereits weißt wie groß der Endwert
    sein wird. For Next sollte nämlich etwas schneller sein.

    In manchen Fällen sind Integer besser als Long, falls du Long nicht unbedingt brauchst.
    Musst du ausprobieren.