Laufzeit - automatischer Aufruf von Subs

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Application.EnableEvents = False Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Call Makro1 Call Makro2 Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub

Hey,
danke schonmal für die Antwort. Die EnableEvents Befehle hatten wir noch nicht drin, ich glaube die haben jetzt schonmal wenigstens ein bisschen was gebracht.
Generell handelt es sich um etwa 10000 Zeilen. Beim sortieren sollen zunächst mehrere ID-Spalten nach Größe sortiert werden und dann miteinander verglichen werden, sodass gleiche IDs in der gleichen Zeile stehen und manche Zeilen dann eventuell teilweise leer sind. Ich würde also vermuten, dass es eine recht umfangreiche Berechnung ist. Ich kann den code aber auch gerne einmal teilen (ist vermutlich aber doch sehr spezifisch), vielleicht hast du ja noch Ideen:


Public Sub sortieren()
    Application.EnableEvents = False
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Worksheets("Hilfsblatt").Activate
    
    For i = 6 To 200
        If InStr(Worksheets("Hilfsblatt").Cells(1, i).Value, "Mitarbeiter") > 0 Then
            Worksheets("Hilfsblatt").Cells(1, i).Value = "Mitarbeiter"
        End If
    Next i
    Dim anzEinträge As Integer
    anzEinträge = 0
    Do
        anzEinträge = anzEinträge + 1
    Loop Until Worksheets("Hilfsblatt").Cells(1, anzEinträge + 5) = "Mitarbeiter"
    Dim anzBlätter As Integer
    anzBlätter = 0
    For i = 6 To 200
        If InStr(Worksheets("Hilfsblatt").Cells(1, i).Value, "Mitarbeiter") > 0 Then
            Worksheets("Hilfsblatt").Cells(1, i).Value = "Mitarbeiter"
        End If
        If Worksheets("Hilfsblatt").Cells(1, i) = "Mitarbeiter" Then
            anzBlätter = anzBlätter + 1
        End If
    Next i
    Dim Bereich As String
    Bereich = ":"
    Dim sortNach As String
    Dim a As Integer
    zahl = 70
    Dim letzterEintrag As Integer
    Dim BereichzumKoppieren As String
    letzterEintrag = 0
    For i = 0 To anzBlätter - 1
        Bereich = Chr(zahl + i * anzEinträge) + ":" + Chr(zahl + i * anzEinträge + anzEinträge - 1)
        sortNach = Chr(zahl + i * anzEinträge + anzEinträge - 1) + "2"
        Range(Bereich).Sort key1:=Range(sortNach)
        If letzterEintrag  Worksheets("Hilfsblatt").Cells(Rows.Count, 6 + i * anzEinträge + anzEinträge - 1).End(xlUp).Row Then
            letzterEintrag = Worksheets("Hilfsblatt").Cells(Rows.Count, 6 + i * anzEinträge + anzEinträge - 1).End(xlUp).Row
        End If
    Next i
    For i = 2 To letzterEintrag + 500
        If Worksheets("Hilfsblatt").Cells(i, 6 + 0 * anzEinträge + anzEinträge - 1) > Worksheets("Hilfsblatt").Cells(i, 6 + 1 * anzEinträge + anzEinträge - 1) Then
            letzterEintragSpalte = Worksheets("Hilfsblatt").Cells(Rows.Count, 6 + 0 * anzEinträge + anzEinträge - 1).End(xlUp).Row
            BereichzumKoppieren = Chr(zahl + 0 * anzEinträge + anzEinträge - anzEinträge) + CStr(i) + ":" + Chr(zahl + 0 * anzEinträge + anzEinträge - 1) + CStr(letzterEintrag + 500)
            Worksheets("Hilfsblatt").Range(BereichzumKoppieren).Copy Destination:=Worksheets("Hilfsblatt").Range(Chr(zahl + 0 * anzEinträge + anzEinträge - anzEinträge) + CStr(i + 1))
            For j = 1 To anzEinträge
                Worksheets("Hilfsblatt").Cells(i, 6 + 0 * anzEinträge + anzEinträge - j) = ""
            Next j
        ElseIf Worksheets("Hilfsblatt").Cells(i, 6 + 0 * anzEinträge + anzEinträge - 1)  Worksheets("Hilfsblatt").Cells(i, 6 + 1 * anzEinträge + anzEinträge - 1) Then
            letzterEintragSpalte = Worksheets("Hilfsblatt").Cells(Rows.Count, 6 + 1 * anzEinträge + anzEinträge - 1).End(xlUp).Row
            BereichzumKoppieren = Chr(zahl + 1 * anzEinträge + anzEinträge - anzEinträge) + CStr(i) + ":" + Chr(zahl + 1 * anzEinträge + anzEinträge - 1) + CStr(letzterEintrag + 500)
            Worksheets("Hilfsblatt").Range(BereichzumKoppieren).Copy Destination:=Worksheets("Hilfsblatt").Range(Chr(zahl + 1 * anzEinträge + anzEinträge - anzEinträge) + CStr(i + 1))
            For j = 1 To anzEinträge
                Worksheets("Hilfsblatt").Cells(i, 6 + 1 * anzEinträge + anzEinträge - j) = ""
            Next j
        End If
    Next i
    letzteZeile1 = Worksheets("Hilfsblatt").Cells(Rows.Count, 6).End(xlUp).Row
    letzteSpalte1 = Worksheets("Hilfsblatt").Cells(1, Columns.Count).End(xlToLeft).Column
    Worksheets("Benutzeroberfläche").Range("B2:" + Chr(64 + letzteSpalte1 - 4) + CStr(letzteZeile1)).Value = Worksheets("Hilfsblatt").Range("F1:" + Chr(64 + letzteSpalte1) + CStr(letzteZeile1 - 1)).Value
    Worksheets("Benutzeroberfläche").Range("B1:" + Chr(64 + letzteSpalte1 - 4) + "1").Value = Worksheets("Hilfsblatt").Range("F" + CStr(letzteZeile1) + ":" + Chr(64 + letzteSpalte1) + CStr(letzteZeile1)).Value
    Dim Mitarbeiterausgewählt As Boolean
    Mitarbeiterausgewählt = True
    For i = 1 To 7
        If Not Worksheets("Hilfsblatt").Cells(i, 4) Like "Mitarbeiter ausgewählt" Then
            Mitarbeiterausgewählt = False
        End If
    Next i
    If Mitarbeiterausgewählt = False Then
        For i = 2 To 100
            If Worksheets("Benutzeroberfläche").Cells(1, i) Like "Mitarbeiter" Then
                Worksheets("Benutzeroberfläche").Columns(i).Delete
                i = i - 1
            End If
        Next i
    End If
    letzteSpalte = Worksheets("Benutzeroberfläche").Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 2 To letzteSpalte
        Worksheets("Benutzeroberfläche").Cells(1, i).Interior.ColorIndex = 35
    Next i
    Worksheets("Benutzeroberfläche").Columns("A:ZZ").AutoFit
    
    Worksheets("Benutzeroberfläche").Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Danke schonmal.
LG Finn64

Dim Bereich as Range, sortNach as Range For i = 0 To anzBlätter - 1 Set Bereich = Range(Columns(6 + i * anzEinträge), Columns(6 + i * anzEinträge + anzEinträge - 1) Set sortNach = cells(2, 6 + i * anzEinträge + anzEinträge - 1) Bereich.Sort key1:=sortNach

Hi
das einfachste wäre, wenn du für den Button ein drittes Makro schreibst, das dann diese beiden Makros nacheinander aufruft.
warum die Rechenzeit so hoch geht, lässt sich so allgemein ohne die Datei zu haben um zu schauen, was da genau passiert, nicht sagen.
Wenn man mit den GetMoreSpeed-Einstellungen arbeitet (Bildschirmaktualisierung aus, Automatische Neuberechnung der Formeln aus, Events aus), dann muss man aufpassen, wann und wo man diese ein- und ausschaltet, damit sie nicht plötzlich dort nicht aktiv sind, wo man es eigentlich erwartet.
diese Aufgabe:
Beim sortieren sollen zunächst mehrere ID-Spalten nach Größe sortiert werden und dann miteinander verglichen werden, sodass gleiche IDs in der gleichen Zeile stehen und manche Zeilen dann eventuell teilweise leer sind.
lässt sich am einfachsten und wahrscheinlich schnellsten so lösen:
Schritt 1:
wenn du die Tabellen A und B hast, dann kopiere die die IDs von B und füge sie unter die IDs von A ein, ebenso kopierst du die IDs von A und fügst sie unter die IDs von B ein, so dass am Schluss in diesen Spalten alle vorkommenden IDs vorhanden sind
Schritt 2:
Wende dann in diesen Spalten das DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN an (VBA: RemoveDuplicates). dann verschwinden in den unten angefügten IDs diejenigen, die schon in der Tabelle vorhanden sind.
jetzt sollte in jeder Tabelle jede ID-Nummer aus allen Tabellen einmal vorhanden sein
Schritt 3:
sortiere jetzt die Tabellen nach dieser Spalte.
Dann hast du in jeder Tabelle die IDs in der selben Zeile, mit den Leerzeilen dazwischen.
Gruß Daniel

Worksheets("Benutzeroberfläche").Range("B2:" + Chr(64 + letzteSpalte1 - 4) + CStr(letzteZeile1)).Value = Worksheets("Hilfsblatt").Range("F1:" + Chr(64 + letzteSpalte1) + CStr(letzteZeile1 - 1)).Value

Set wks1=Worksheets("Benutzeroberfläche") Set wks2=Worksheets("Hilfsblatt") wks1.Range(wks1.Cells(2,2),wks1.Cells(letzteZeile1,letzteSpalte1 - 4).Value=wks2.Range(wks2.Cells(1,6), wks2Cells(letzteZeile1 - 1, letzteSpalte1)

Beliebteste Forumthreads (12 Monate)

Laufzeit - automatischer Aufruf von Subs

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread