So bei der Arbeit arbeite ich an einem Makro / UserForm in Excel für jemanden. Es funktioniert großartig (glaube ich) und macht genau das, was es tun muss. Es dauert weniger als 1 Minute, bis es durch ~ 70.000 Zellen geht und sie organisiert. Jetzt habe ich mich gefragt, ob es eine Möglichkeit gibt, es zu verlangsamen, damit Excel während der Ausführung nicht in den Modus "Reagiert nicht" wechselt. Es wäre einfach besser, damit Leute, die das Makro verwenden müssen, nicht ausflippen, wenn es einfriert. Und es wäre am besten, wenn es eine Lösung in VBA gäbe, damit sich die Leute darüber keine Sorgen machen müssen und es beim ersten Mal perfekt funktioniert.

Über das Makro

Die Daten sind eine Reihe von Zahlen, die in eine Spalte gesetzt werden müssen, und die 14 (normalerweise 14) Spalten, bevor sie jede Zahl mit Datumsangaben und anderen Daten beschriften. Alle Größenangaben und Blattnamen müssen aus einer UserForm stammen, damit ich den Namen der Blätter oder die Größe nicht vorher kenne. Dies führte zu einem seltsamen Code am Anfang meiner Schleife.

Auch wenn Sie trotzdem sehen, um meinen Code effizienter zu machen, wäre das sehr dankbar!

Der Cod

Private Sub UserForm_Initialize()

    'This brings up the data for my dropdown menu to pick a sheet to pull data from
    For i = 1 To Sheets.Count
        combo.AddItem Sheets(i).name
    Next i

End Sub

Private Sub OK_Click()

    Unload AutoPivotusrfrm

    'Declaring All of my Variables that are pulled from Userform

    Dim place As Long

    Dim x1 As Integer
    x1 = value1.Value
    Dim x2 As Integer
    x2 = value2.Value
    Dim x3 As Integer
    x3 = value4.Value
    Dim y1 As Integer
    y1 = value3.Value

    Dim copyRange As Variant

    Dim oldname As String
    oldsheetname = combo.Text

    Dim newname As String
    newname = newsheetname.Text

    Sheets.Add.name = newsheetname

    'Labels for section one
    Worksheets(CStr(oldsheetname)).Activate
    copyRange = Range(Cells(x1, x1), Cells(x1 + 1, x3 - 1)).Value
    Worksheets(CStr(newsheetname)).Activate
    Range(Cells(x1, x1), Cells(x1 + 1, x3 - 1)).Value = copyRange
    place = x1 + 2
    x1 = place


    'Looping through the cells copying data
    For i = x1 To x2
    'This was the only way to copy multiple cells at once other ways it would just error
        Worksheets(CStr(oldsheetname)).Activate
        copyRange = Range(Cells(i + 3 - x1, x1 - 2), Cells(i + 3 - x1, x3 - 1)).Value
        Worksheets(CStr(newsheetname)).Activate
        For j = x3 To y1
            Range(Cells(place, 1), Cells(place, x3 - 1)).Value = copyRange
            Cells(place, x3) = Sheets(CStr(oldsheetname)).Cells(1, j)
            Cells(place, x3 + 1) = Sheets(CStr(oldsheetname)).Cells(2, j)
            Cells(place, x3 + 2) = Sheets(CStr(oldsheetname)).Cells(i + 2, j)
            place = place + 1
        Next j
    Next i

End Sub

Private Sub cancel_Click()

    Unload AutoPivotusrfrm

End Sub