Excel 提高VBA性能

Excel 提高VBA性能,excel,vba,Excel,Vba,我有一个VBA代码,用于迭代案例ID的排序数据,如果它们相同,则将该行转换为匹配行 电子表格中大约有20k行需要查看。整个代码运行通常需要20-40分钟。我不确定我做错了什么 Sub MyCombineRows() Dim r As Long Dim lngRow As Long Dim lngCol As Long Dim LastColumn As Long Dim sht As Worksheet Set sht = ActiveShe

我有一个VBA代码,用于迭代案例ID的排序数据,如果它们相同,则将该行转换为匹配行

电子表格中大约有20k行需要查看。整个代码运行通常需要20-40分钟。我不确定我做错了什么

Sub MyCombineRows()


    Dim r As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim LastColumn As Long
    Dim sht As Worksheet
    Set sht = ActiveSheet
    'Application.ScreenUpdating = False

'   Set first row to start on (skipping first row of data)
    r = 3
    lngRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    LastColumn = findLastCol(r - 1)

    Do
'       Check to see if columns A is equal to row above it
        If (Cells(r, "A") = Cells(r - 1, "A") And Cells(r, "A").Value <> "") Then
'           Copy value from column to end of row above it
            Range(Cells(r, 1), Cells(r, LastColumn)).Select
            Selection.Cut
            Cells(r - 1, LastColumn + 1).Select
            ActiveSheet.Paste
           'Delete Row
            Rows(r).Delete
            Do
                If (Cells(r, "A") = Cells(r - 1, "A") And Cells(r, "A").Value <> "") Then
                    Dim newLastCol As Long
                    newLastCol = findLastCol(r - 1)
                    Range(Cells(r, 1), Cells(r, LastColumn)).Select
                    Selection.Cut
                    Cells(r - 1, newLastCol + 1).Select
                    ActiveSheet.Paste
                    Rows(r).Delete
                Else
                    r = r + 1
                    If Cells(r, "A").Value = "" Then
                        Exit Do
                    End If
                End If
            Loop Until r = lngRow
        Else
'           Move on to next row
            r = r + 1
        End If
    Loop Until r = lngRow


End Sub

Function findLastCol(rowNum As Long) As Long
    Dim sht As Worksheet
    Set sht = ActiveSheet
    findLastCol = sht.Cells(rowNum, sht.Columns.Count).End(xlToLeft).Column
End Function

可能是删除操作使您的速度变慢,因为它每次都试图更新UI,这通常非常慢。 尝试 Application.ScreenUpdating=False 在代码的开头,然后在完成后再次将其切换为true


或者,只需使用标志标记删除,并删除在末尾设置标志的所有行

使用变量数组来存储和循环。限制vba必须引用工作表的次数。在代码开头使用Application.ScreenUpdate=False并在结尾将其重置为True总是有帮助的。另外,一般来说,您希望在代码中也不使用复制和粘贴,而是设置和读取范围对象的.value参数。与应用程序物理对象的交互是其糟糕的原因。简单地说,对于流程的每次迭代,您必须进行处理,然后将结果发送回必须处理您的请求的应用程序,然后将其应用于对象,然后将控制发送回代码。根据您对应用程序更改其“物理项/对象/组件”的期望程度,此行为往往不会产生指数效应。TL;DR-尽可能不要玩应用程序对象。我会使用a将ID与其索引一起存储在数组中,以避免匹配耗时的应用程序。计算模式可能比屏幕更新更有效,使用此全局应用程序状态掩盖低效代码是一种非常常见的错误做法。解决方案是停止选择和删除剪贴板,仅在需要与工作表交互时才与工作表交互。切换Application.screenUpdatement/Calculation/EnableEvents并不能神奇地让低效的代码更快地工作,它只是让Excel在工作表调用之间工作得更少,而这些调用本来就不应该存在。至于标记删除部分,这也是错误的,因为它引入了更多的工作表交互。通过合并要删除的行,然后在单个工作表操作中删除该组合范围,完成删除标记;当只有一个工作表操作发生时,计算/屏幕更新/启用事件切换几乎没有区别。