vba - 如何防止宏使 Excel 窗口卡住/变白？

Question

因此，在工作中，我正在为某人编写 Excel 中的宏/用户表单。它工作得很好(我认为)，并且完全完成了它需要做的事情，并且运行时间不到 1 分钟，遍历了大约 70k 个单元并组织它们。现在我想知道是否有办法减慢它的速度，以便 Excel 在运行时不会进入“无响应”模式。这样会更好，这样需要使用宏的人就不会在它卡住时 panic 。如果 VBA 中有一个解决方案那就最好了，这样人们就不必担心它并且第一次就可以完美地工作。

关于宏

数据是一堆数字，需要放在一列中，并且前面的 14(通常是 14)列用日期和其他数据标记每个数字。所有尺寸引用和工作表名称都需要来自用户表单，因此我提前不知道工作表的名称或尺寸，这导致在循环开始时出现一些奇怪的代码。

此外，如果您认为无论如何可以使我的代码更加高效，我们将不胜感激!

代码

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 变得无响应。

另一种方法是加速代码，以便在用户有理由相信代码崩溃之前完成。本着这一精神，这里有一些建议:

1. 关闭屏幕更新:Excel 渲染屏幕需要做大量工作。您可以通过在代码开头添加 Application.ScreenUpdating = False 并将 Application.ScreenUpdating = True 添加到末尾来释放这些资源来完成您需要完成的工作。

2. 关闭计算:如果您正在运行大量公式，这可能会减慢您将值放入工作簿时的速度，因为它需要重新计算。我首选的处理方法是存储当前的计算设置，关闭计算，然后在最后恢复原始设置。

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 Ranges 数组仍然受到 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