Hallo zusammen,

ich habe vor rund 6 Wochen das erste mal meine Nase in ein Buch zu VBA für Excel gesteckt und konnte es inzwischen auch mal anwenden.

Dummerweise läuft das Ganze recht langsam ab. Bei meinen ersten Versuchen (die funktionierten) dauerte die Ausführung rund 16 Minuten.

Inzwischen bin ich bei knapp 9 Minuten (auf einer älteren Excel Version und einem langsamen PC *hab ich den Eindruck*).

Dateien:

Makro.xlsm - Mit dem Makro drin und einem Knopf, der das Ganze ausführt.

Hier werden dann die beiden Dateien geöffnet (Teil1.xls und Teil2.xls). Diese Dateien beinhalten zusammen rund 70.000-80.000 Zeilen (daher auch die Trennung). Die Excel-Version mit der ich "dabei" Arbeite packt nut 65xxx.

Ich durchlaufe nun Spalte 5 (E) und schaue mir die "Kundennummer" an. In der Mitte füge ich noch "00" ein (nebenbei). Hierbei wird der gefundene Wert entweder in einer neu erstellten Arbeitsmappe in Spalte A angefügt oder - wenn die Kundennummer schon existiert - der Wert in Spalten 2-5 entsprechend aufsummiert (in welche Spalte es geht, wird in Spalte H der Teil-Dateien ausgelesen).

Nebenbei gibt es noch Ausschlussfaktoren in Spalte 2 der Teil-Dateien. Hierbei wird die Zeile dann ignoriert.

Der Code funktioniert so wie er soll. Es geht mir hier 1.) um einen sauberen Code (wie gesagt bin ich Anfänger) und 2.) um die Geschwindigkeit.

Ein Beispiel (keine Originaldateien, nur Beispielhaft nachgebaut) findet ihr hier: http://www.fileuploadx.de/928268

Hat jemand Tipps für mich?

Viele Grüße

Sub Zusammenfuegen()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    Dim DateiName(1 To 2) As String
    Dim Pfad(1 To 2) As String
    Dim i As Long
    Dim nWB As Workbook
    Dim lz As Long, efz As Long, z As Long      'lz=letzte Zeile; efz=erste freie Zeile
    Dim offs As Long                            'offset
    Dim nW As String
               
    Pfad(1) = Workbooks("Makros.xlsm").Path & "\"
    Pfad(2) = Workbooks("Makros.xlsm").Path & "\"
   
    DateiName(1) = "Teil1.xls"
    DateiName(2) = "Teil2.xls"
         
    Set nWB = Workbooks.Add
   
    Cells(1, 1).Value = "Ü1"
    Cells(1, 2).Value = "Ü2"
    Cells(1, 3).Value = "Ü3"
    Cells(1, 4).Value = "Ü4"
    Cells(1, 5).Value = "Ü5"
   
    For i = 1 To 2
        Workbooks.Open Filename:=Pfad(i) & DateiName(i)
        lz = Range("E:E").End(xlDown).Row
       
        For z = 1 To lz - 1
            If (Cells(z + 1, 2).Value <> "Ausschluss1") And (Cells(z + 1, 2).Value <> "Ausschluss2") And (Cells(z + 1, 2).Value <> "Ausschluss3") And (Cells(z + 1, 2).Value <> "Ausschluss4") Then

           
                Select Case Cells(z + 1, 8).Value
                        Case Is = "Ü2"
                            offs = 1
                        Case Is = "Ü3"
                            offs = 2
                        Case Is = "Ü4"
                            offs = 3
                        Case Is = "Ü5"
                            offs = 4
                End Select
           
                nW = Val(Mid(Cells(z + 1, 5), 1, 4) & "00" & Mid(Cells(z + 1, 5), 5, 8))
           
                If Cells(z + 1, 5).Value = Cells(z, 5).Value Then
                    nWB.Sheets(1).Range("A:A").Find(What:=nW).Offset(0, offs).Value = _
                    nWB.Sheets(1).Range("A:A").Find(What:=nW).Offset(0, offs).Value _
                    + Cells(z + 1, 13)
                Else
                    efz = nWB.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Row
                    nWB.Sheets(1).Cells(efz, 1).Value = nW
                    nWB.Sheets(1).Cells(efz, offs + 1).Value = _ 
                    nWB.Sheets(1).Cells(efz, offs +1) + 1).Value + _
                    Cells(z + 1, 13)
                End If
            End If
        Next z
        Workbooks(DateiName(i)).Close (False)
    Next i
   
    nWB.SaveAs Filename:=Workbooks("Makros.xlsm").Path & "\" & Format(Date, "YYYYMMDD") & "_Ergebnis.xls"
    nWB.Close (False)
       
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

    MsgBox "Datei unter " & Workbooks("Makros.xlsm").Path & "\" & Format(Date, "YYYYMMDD") & "_Ergebnis.xls gespeichert."

End Sub