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

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

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

1. 关闭屏幕更新：显示屏幕是一项很大的工作。通过将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

1. 使用工作表变量:持续按名称访问工作表的。对于重复访问，应该更快地将其存储在变量中。同时，不要使用Activate或Select。完全引用对Cells的调用，以便它访问正确的工作表。

​

​

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

1. 使用变体数组：--这将最大限度地加快您的代码速度，但也有一个警告。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