如何防止宏冻结/变白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. 关闭屏幕更新: 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

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

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

4. 使用变体数组: 这应该最能加速你的代码,但也有一个警告.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