Question

我有两个宏：

宏1：将大型工作表复制粘贴到同一工作簿中（基本上是myWorksheet.copy：= lastWorksheet）

宏2：迭代新工作表中的数据以取消合并任何合并的单元格。然后将每个MergeArea中所有单元格的值设置为原始合并单元格的值。

两个宏都按预期运行。

问题是运行时。如果我在同一会话中运行Macro 1和Macro 2＆＃39; （必须采用的方式）Macro 2的运行时间大约为250秒。如果我运行宏1，然后重新启动Excel并运行宏2，宏2只需要1/3的时间（〜70秒）。

我在运行Macro 1后尝试清除剪贴板，但它什么也没做。否则，我没有想法。

宏1：

Sub copySheet()
Dim ws As Worksheet

Application.DisplayAlerts = False

Set ws = ThisWorkbook.Worksheets("BigData")

ws.Copy After:=ThisWorkbook.Worksheets("BigData")

Application.DisplayAlerts = True
End Sub

宏2：

Sub unmergeCells()
Dim ws As Worksheet
Dim szArr() As Integer
Dim i%, k%, j%, col%
Dim strt&
'First row
Const fr% = 9
'First column
Const fc% = 12
'Last column
Const lc% = 135 
'Last row
Const lr% = 1196

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set ws = ThisWorkbook.Worksheets("BigData (2)")

strt = VBA.Timer

With ws
    For col = fc To lc
        'Some columns only have to be unmerged without changing any values
        If IsNumeric(.Cells(fr - 1, col)) Then
            .Range(.Cells(fr, col), .Cells(lr, col)).UnMerge
            GoTo Skip_Ahead
        End If

        i = fr
        k = 0
        Do While i <= lr
            ReDim Preserve szArr(k)
            szArr(k) = i

            i = i + .Cells(i, col).MergeArea.Cells.Count
            k = k + 1
        Loop

        .Range(.Cells(fr, col), .Cells(lr, col)).UnMerge

        For i = 0 To UBound(szArr) - 1
            For j = szArr(i) + 1 To szArr(i + 1) - 1
                .Cells(j, col) = "'" & .Cells(szArr(i), col)
            Next j
        Next i
Skip_Ahead:
        Debug.Print col & ": " & Timer - strt
    Next col
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

如果我之前没有运行第一部分，那么下半年VBA宏的运行速度要快3倍

0 个答案: