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

所以在工作中，我正在为某人在Excel中编写宏/用户表单。它工作得很好（我认为），完全可以完成它需要做的事情，运行不到1分钟，通过~70k个单元并组织它们。现在我想知道是否有一种方法可以让它慢下来，这样Excel在运行时就不会进入“无响应”模式。这样会更好，当宏冻结时，需要使用宏的人不会惊慌失措。如果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

---

正如@stuartd在评论中提到的，

DoEvents

可能允许用户在宏运行时与Excel交互，并防止Excel变得无响应

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

关闭屏幕更新：Excel需要做大量工作才能呈现屏幕。通过在代码开头添加

Application.screenUpdate=False

，在末尾添加

Application.screenUpdate=True，您可以释放这些资源来完成所需的工作

关闭计算：如果有大量公式正在运行，这可能会降低将值放入工作簿时的速度，因为它需要重新计算。我比较喜欢的处理方法是存储当前的计算设置，关闭计算，然后在最后恢复原始设置

使用工作表变量：您一直按名称访问工作表。对于重复访问，应该更快地将其存储在变量中。同时，不要使用

激活

或

选择

。完全引用您调用的

单元格

，以便它访问正确的工作表

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

---

希望在VBA中实现进度条。Google上有很多比进度条更简单的例子：在每一轮循环后，更新

应用程序。状态栏

上有您选择的文本，如“y行x”，这回答了很多问题，谢谢！我是VBA新手，所以我只是想让它发挥作用，你帮我让它变得更快。所以我在做你上面发布的一些东西，除了我开始做变体的时候，一切都很好。我在这一行得到错误1004

Dim oldsheetValue1作为变量oldsheetValue1=oldsheet.Range（oldsheet.Cells（I+3-x1，x1-2），oldsheet.Cells（I+3-x1，x3-1））。值

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

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

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