VBA Codeoptimierung

Moderator: ModerationP

VBA Codeoptimierung

Beitragvon XsiFluxx » 06. Okt 2017, 11:35

Hallo zusammen,

ich hätte da mal nen mittelscheweres Problem.
Ich muss Exceldateien sortieren, die aus 174717 Zeilen, 414362 Zeilen und 52352 Zeilen bestehen.
Der Aufbau ist etwas komplex und geht von "A" bis "AO".

Ich nehme zuerst eine Kostenstelle und gehe damit in den Dateien auf die Suche.
Finde ich einen Treffer zu der Kostenstelle, loope ich solange, bis der Wert sich ändert.
Diese Treffer kopiere ich in ein neues Blatt mit Namen der Kostenstelle.
Aber schon der Durchlauf auf der Datei mit 174717 Zeilen dauert mehr als 2 Stunden.
Code: Alles auswählen
Private Sub CommandButton1_Click()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, g As Long
    Dim sapsystem As Byte
    Dim id As String, nameB As String
    Dim lastcell As Long, lastsap As Long, lasts As Long
    sapsystem = 0
        ComboBox1.Clear
        Sheets("Kostenstelle").Select
        lastcell = Cells(Rows.Count, 1).End(xlUp).Row
            For c = 2 To lastcell
                If Range("a" & c).Value <> "" Then
                    ComboBox1.AddItem Range("a" & c).Value
                End If
            Next c
            g = 0
            For d = 0 To ComboBox1.ListCount - 1
                id = ComboBox1.List(d)
                nameB = id
                Sheets("PB1").Select
                lastsap = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zelle bestimmen
                    For e = 2 To lastsap
                        If Range("G" & e).Value = bhwid Then
                                If g = 0 Then
                                    Sheets.Add(after:=Sheets(Sheets.Count)).Name = nameB
                                End If
                                Sheets("PB1").Select
                                f = e
                                Do
                                    f = f + 1
                                    g = g + 1
                                Loop While Range("G" & f).Value = id ' Status in "AO" pflegen
                                If f = e Then
                                    Range("AO" & e & ":" & "AO" & e).Select
                                    Selection.Value = "X" & "|" & Date & "|" & Time
                                    Range("A" & e & ":" & "AJ" & e).Select
                                ElseIf f <> e Then
                                    Range("AO" & e & ":" & "AO" & f - 1).Select
                                    Selection.Value = "X" & "|" & Date & "|" & Time
                                    Range("A" & e & ":" & "AJ" & f - 1).Select
                                End If
                                Selection.Copy
                                Sheets(nameB).Select
                                lasts = Cells(Rows.Count, 1).End(xlUp).Row + 1
                                Range("A" & lasts).Select
                                ActiveSheet.Paste
                                Sheets("PB1").Select
                        End If
                    Next e
                    g = 0
            Next d
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub


Hat jemand eine Idee, wo ich noch dran schrauben kann, damit die Ausführung schneller abläuft ?
Denn während der Code läuft, kann ich keinerlei Officeprodukte mehr nutzen....

Danke Euch

XsiFluxx
XsiFluxx
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5
Registriert: 06. Okt 2017, 11:26

Variant-Array

Beitragvon ehem. lupo1 » 06. Okt 2017, 11:45

Packe Deine Tabelle in ein Variant-Array. Aufgrund der Größe musst Du dies evtl. sehr selektiv tun!

In http://xxcl.de/0052.htm benötigt die Sub "Gegenüberstellung" für 32000 Zeilen und 4 Spalten nur 0,3 Sekunden.
ehem. lupo1
 

Außerdem ...

Beitragvon ehem. lupo1 » 06. Okt 2017, 11:48

- verwendet man keine Blätter pro Kostenstelle. Das ist EDV von vor Christus!
- kann man mit Pivot oder Power Query Deine Aufgabe in vermutlich 15 Sekunden erledigen
ehem. lupo1
 

Re: VBA Codeoptimierung

Beitragvon XsiFluxx » 06. Okt 2017, 11:52

Hallo Lupo1, danke für Deine Antworten :

Ich bin für alles offen, aber von Pivot etc hab ich keine Ahnung .

Die Kostenstellen werden je User geführt und jeder User hat N SAP Rollen, die wiederum M Einzelrollen haben.
Somit kommt die extreme Datenmenge zusammen, daher habe ich die Kostenstellen kopiert und durch "Duplikate entfernen" reduziert und das Ergebnis in ein extra Blatt gepackt.
Und da ich durch diverse Gesetze gezwungen bin, die Berechtigungen überprüfen zu lassen und niemand in der Firma Geld für eine andere Lösung hat oder haben will,
muss ich hier in der Steinzeit arbeiten und diese riesigen Datenmengen quasi per Hand verwursten.

//EDITH:
Ich darf hier in der Firma keinerlei andere Software installieren, als verfügbar. Und im offiziellen Softwarekatalog gibt es leider kein Powerquery. Hier ist mein Arbeitgeber leider sehr restriktiv :(
XsiFluxx
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5
Registriert: 06. Okt 2017, 11:26

Das normale Pivot ...

Beitragvon ehem. lupo1 » 06. Okt 2017, 12:35

... lernst Du heute abend an Deinem Zuhause-Rechner in 15 Minuten.

Pivot

- stellt die Daten in nur einem einzigen Durchgang zusammen! Und zwar für alle Kostenstellen gleichzeitig.
ehem. lupo1
 

Re: VBA Codeoptimierung

Beitragvon XsiFluxx » 06. Okt 2017, 12:47

Dein Wort in Gottes Gehörgang.
Kann man durch eine Pivot auch neue Tabellen erzeugen ?
Denn die Ergebnisse auf Kostentellenbasis müssen dann an die jeweiligen Besitzer der Kostenstellen zur Kontrolle gegeben werden.
Und dann muss ich in der Ursprungstabelle alle gefilterten Werte markieren, damit am Ende bei einer Prüfung durch Revision oder andere festgestellt werden kann, ob alle Datensätze bearbeitet worden sind...

//EDITH
Nunja, ich habe gerade mal eine Pivot versucht ... Fehlermeldung von Excel nicht genügend Ressourcen etc... Na da leb ich wohl erstmal mit dem VBA Code.
Habe hier ne virtuelle Maschine Xeon E5 mit 4GB RAM
XsiFluxx
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5
Registriert: 06. Okt 2017, 11:26

Re: VBA Codeoptimierung

Beitragvon HKindler » 06. Okt 2017, 13:33

Hi,

deine Routine würde sicherlich deutlich schneller laufen, wenn du auf das Select-ieren und die ständigen Blattwechsel verzichten würdest. Auch ansonsten sind einige seltsame Auswüchse in deiner Routine:
Range("AO" & e & ":" & "AO" & e) wieso nicht einfach Range("AO" & e)
If f = e Then ... ElseIf f <> e Then Wenn f=e nicht zutrifft, warum dann nochmals prüfen, ob f<>e? Was soll es denn sonst sein?
Gruß,
Helmut

----------------------------
Windows 8.1 (64 Bit) / Office 2013 (32 Bit)
HKindler
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 1495
Registriert: 04. Jul 2013, 09:02


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: Hajo_Zi, OldFuzzy und 12 Gäste