Question

所以在工作中我正在为某人的Excel中的宏/ UserForm工作。它工作得很好（我认为）并完全按照它需要做的工作，需要不到1分钟才能运行，经过~70k的细胞并组织它们。现在我想知道是否有办法减慢速度，以便Excel在运行时不会进入“无响应”模式。它会更好，所以需要使用宏的人在冻结时不会发疯。最好是在VBA中有解决方案，这样人们就不必担心它，并且第一次完美运行。

关于宏

数据是一堆数字，需要放在一列中，并且在它之前的14（通常是14）列用日期和其他数据标记每个数字。所有大小的引用和工作表名称都需要来自UserForm，因此我不知道工作表的名称或大小，这会在循环开始时产生一些奇怪的代码。

此外，如果你看到我的代码更高效，那将非常感激！

守则

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

Answer 1

正如@stuartd在评论中提到的，DoEvents可能允许用户在宏运行时与Excel交互，并防止Excel无响应。

另一种方法是加速您的代码，以便在用户有理由相信它已崩溃之前完成。在这方面，这里有一些建议：

关闭屏幕更新：Excel渲染屏幕需要做很多工作。您可以通过将Application.ScreenUpdating = False添加到代码的开头，并将Application.ScreenUpdating = True添加到最后，释放这些资源来处理您需要完成的工作。
关闭计算：如果您运行了很多公式，这可能会减慢将值放入工作簿时发生的情况，因为它需要重新计算。处理此问题的首选方法是存储当前计算设置，关闭计算，然后在结束时恢复原始设置。

Dim Calc_Setting as Long
Calc_Setting = Application.Calculation
Application.Calculation = xlCalculationManual
'Your code here
Application.Calculation = Calc_Setting

使用工作表变量：您将继续按名称访问工作表。对于重复访问，将其存储在变量中应该更快。除此之外，请勿使用Activate或Select。完全引用您对Cells的调用，以便它访问正确的工作表。

Dim oldsheet as Worksheet, newsheet as Worksheet
Set oldsheet =  Worksheets(CStr(oldsheetname))
Set newsheet =  Worksheets(CStr(newsheetname))
oldsheet.Cells(place, x3) = ...

使用变体数组：这应该可以最大限度地提高代码速度，但也有警告。 Excel和VBA在交互时很慢。在你的内循环中，VBA正在访问Excel 7次。通过将这些交互拉出循环，我们可以实现严重的性能提升。问题是读取/写入Excel范围的数组仍受2003大小限制（65536行，...）的约束。如果你希望获得比这更多的数据，你需要做一些体操才能使它发挥作用。

Dim inVal as Variant, Output as Variant

inVal = Range(oldsheet.Cells(1,x1-2),oldsheet.Cells(x2+3-x1,y)).Value
redim output(1 to (x2-x1) * (y-x3) + 2, 1 to x3+2)
'These numbers are not tested, you should test.

'Loops to fill output.  This will need to be 1 entry at a time.

newsheet.Cells(x1,x1).Resize(Ubound(output,1), Ubound(output,2)).Value

如何防止宏冻结/变白Excel窗口？

1 个答案: