VBA和Excel优化脚本,处理700000行

VBA和Excel优化脚本,处理700000行,vba,excel,optimization,Vba,Excel,Optimization,各位好,飞越者 我目前正在编写一个脚本,其中包含一个嵌套的IF语句。运行时,它可能会计算出约140万个IF 我用一个计时器运行了一个测试(不太确定VBA中计时器的准确性),处理1000行给了我10秒的时间。10*700=7000秒,即1.94小时 在处理如此大的数据集时,有人能给我一些优化的建议吗 我的代码如下 Sub itS1Capped() Dim Start, Finish, TotalTime Start = Timer Dim c, d, j, lastRow

各位好,飞越者

我目前正在编写一个脚本,其中包含一个嵌套的IF语句。运行时,它可能会计算出约140万个IF

我用一个计时器运行了一个测试(不太确定VBA中计时器的准确性),处理1000行给了我10秒的时间。10*700=7000秒,即1.94小时

在处理如此大的数据集时,有人能给我一些优化的建议吗

我的代码如下

Sub itS1Capped()
    Dim Start, Finish, TotalTime
    Start = Timer
    Dim c, d, j, lastRow
    c = 1

    'find how many rows
    With Worksheets("Data")
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'loop through all rows
    For Each d In Worksheets("Data").Range("D2:D" & lastRow).Cells 'd = IT S0 Uncapped

        j = Worksheets("Data").Range("J" & c + 1).Value  'IT Cap
        If j <> 0 Then

            If d > j Then
                Worksheets("Data").Range("K" & c + 1).Value = j 'IT S1 Capped = j
            Else
                 Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d
            End If
        Else
            Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d
        End If
        c = c + 1
    Next
    Finish = Timer
    TotalTime = Finish - Start
    MsgBox TotalTime
End Sub
Sub-itS1Capped()
暗淡的开始、结束、总时间
开始=计时器
尺寸c、d、j、最后一排
c=1
'查找有多少行
带工作表(“数据”)
lastRow=.Cells(.Rows.Count,“A”).End(xlUp).Row
以
'在所有行中循环
对于工作表中的每个d(“数据”).Range(“D2:d”和lastRow)。单元格'd=IT S0未加盖
j=工作表(“数据”)。范围(“j”和c+1)。值为“IT Cap”
如果j0那么
如果d>j那么
工作表(“数据”).范围(“K”&c+1).值=j'它S1=j
其他的
工作表(“数据”)。范围(“K”&c+1)。值=d'它S1=d
如果结束
其他的
工作表(“数据”)。范围(“K”&c+1)。值=d'它S1=d
如果结束
c=c+1
下一个
完成=计时器
总时间=完成-开始
MsgBox总时间
端接头

我不确定这是否会有所不同,但由于您正在计时,我很想知道

我稍微修改了你的代码。主要更改是针对工作表中的每个D。否则,我使用单元格(行、列)而不是范围。并不是说我希望这种改变能节省时间,我只是认为您可能希望看到另一种定义单元格的方法,而不是将字母和数字连接起来。
注意:对于单元格,您可以使用所有变量和数字,而不使用字母。我只是用字母来表示相似之处

另外,既然每行都有一个c+1,为什么不从第2行开始,去掉倍数(+1),然后从那里开始呢

未经测试

Sub itS1Capped()
    Dim Start, Finish, TotalTime    'What are you declaring these variables as?
    Dim c, d, j, lastRow

    Start = Timer

    'find how many rows
    lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).row

    'loop through all rows
    For c = 2 To lastRow                             'c = IT S0 Uncapped  (OLD d)

        j = Sheets("Data").Cells(c, "J").Value          'IT Cap   = Cells(c, 10)
        If j <> 0 Then

            If c > j Then
                Sheets("Data").Cells(c, "K").Value = j  'IT S1 Capped = j    
            Else
                Sheets("Data").Cells(c, "K").Value = c  'IT S1 Capped = c
            End If
        Else
            Sheets("Data").Cells(c, "K").Value = c      'IT S1 Capped = c
        End If
    Next c
    Finish = Timer
    TotalTime = Finish - Start
    MsgBox TotalTime
End Sub
Sub-itS1Capped()
Dim Start,Finish,TotalTime'您将这些变量声明为什么?
尺寸c、d、j、最后一排
开始=计时器
'查找有多少行
lastRow=工作表(“数据”)。单元格(Rows.Count,“A”)。结束(xlUp)。行
'在所有行中循环
对于c=2至最后一行'c=S0未加盖(旧d)
j=表格(“数据”)。单元格(c,“j”)。数值‘IT Cap=单元格(c,10)
如果j0那么
如果c>j,那么
表格(“数据”)。单元格(c,“K”)。值=j'它S1=j
其他的
表格(“数据”)。单元格(c,“K”)。值=c'它S1=c
如果结束
其他的
表格(“数据”)。单元格(c,“K”)。值=c'它S1=c
如果结束
下一个c
完成=计时器
总时间=完成-开始
MsgBox总时间
端接头

编辑:将d替换为c

我不确定它是否会产生影响,但由于您正在计时,我很想知道

我稍微修改了你的代码。主要更改是针对工作表中的每个D。否则,我使用单元格(行、列)而不是范围。并不是说我希望这种改变能节省时间,我只是认为您可能希望看到另一种定义单元格的方法,而不是将字母和数字连接起来。
注意:对于单元格,您可以使用所有变量和数字,而不使用字母。我只是用字母来表示相似之处

另外,既然每行都有一个c+1,为什么不从第2行开始,去掉倍数(+1),然后从那里开始呢

未经测试

Sub itS1Capped()
    Dim Start, Finish, TotalTime    'What are you declaring these variables as?
    Dim c, d, j, lastRow

    Start = Timer

    'find how many rows
    lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).row

    'loop through all rows
    For c = 2 To lastRow                             'c = IT S0 Uncapped  (OLD d)

        j = Sheets("Data").Cells(c, "J").Value          'IT Cap   = Cells(c, 10)
        If j <> 0 Then

            If c > j Then
                Sheets("Data").Cells(c, "K").Value = j  'IT S1 Capped = j    
            Else
                Sheets("Data").Cells(c, "K").Value = c  'IT S1 Capped = c
            End If
        Else
            Sheets("Data").Cells(c, "K").Value = c      'IT S1 Capped = c
        End If
    Next c
    Finish = Timer
    TotalTime = Finish - Start
    MsgBox TotalTime
End Sub
Sub-itS1Capped()
Dim Start,Finish,TotalTime'您将这些变量声明为什么?
尺寸c、d、j、最后一排
开始=计时器
'查找有多少行
lastRow=工作表(“数据”)。单元格(Rows.Count,“A”)。结束(xlUp)。行
'在所有行中循环
对于c=2至最后一行'c=S0未加盖(旧d)
j=表格(“数据”)。单元格(c,“j”)。数值‘IT Cap=单元格(c,10)
如果j0那么
如果c>j,那么
表格(“数据”)。单元格(c,“K”)。值=j'它S1=j
其他的
表格(“数据”)。单元格(c,“K”)。值=c'它S1=c
如果结束
其他的
表格(“数据”)。单元格(c,“K”)。值=c'它S1=c
如果结束
下一个c
完成=计时器
总时间=完成-开始
MsgBox总时间
端接头

编辑:将d替换为c

在运行脚本之前是否尝试过关闭自动重新计算

Application.Calculation = xlCalculationManual
完成后再打开它

Application.Calculation = xlCalculationAutomatic

如果在处理下一行(或后续行)之前不更改需要重新计算的内容,则通常会加快处理大量行的速度。

在运行脚本之前是否尝试过关闭自动重新计算

Application.Calculation = xlCalculationManual
完成后再打开它

Application.Calculation = xlCalculationAutomatic

这通常会加快对大量行的处理速度,前提是在处理下一行(或后续行)之前,您没有更改需要重新计算的内容。

我现在无法测试这一点,但我相信如果您编写一个函数来替换嵌套的if语句,请使用

然后将其复制到单元格(lastrow,“K”),复制所有函数并粘贴为值,这样会更快

当然用

Application.Calculation = xlCalculationManual

就像敌人建议的那样

Application.screenupdate = false
可能会使它稍微快一点,但我认为复制粘贴功能会带来最大的不同

我现在没有时间发布更新后的代码,但希望我明天能看到

希望有帮助

编辑:这是修改后的代码

警告:我还不能测试这段代码。我明天会这样做,如果需要的话会修改

Sub FunctionCopyPaste()
    Dim iLastRow as Integer

    With Worksheets("Data")
        iLastRow = .UsedRange.Cells(.UsedRange.Rows.Count,1).Row
        .Range("K2").Formula = "=IF(J2<>0,IF(D2>J2,J2,D2),D2)"
        .Range("K2").Copy Range(Cells(2,4), Cells(iLastRow,1).Row,4))
    End With

    With Range(Cells(2,4), Cells(iLastRow,4))
        .Copy
        .PasteSpecial xlPasteValues
    End With

End Sub
子函数copypaste()
Dim iLastRow作为整数
带工作表(“数据”)
Sub FormulaArray()
    Dim iUsedRows As Long, rCell As Range, StartTimer As Double, Duration As Double

    StartTimer = Timer
    iUsedRows = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Rows.Count, 1).Row

    With Range(Cells(1, 11), Cells(iUsedRows, 11))
        .FormulaArray = "=IF(J:J<>0,IF(D:D>J:J,J:J,D:D),D:D)"
        .Copy
        .PasteSpecial xlPasteValues
    End With

    Duration = StartTimer - Timer
    MsgBox Format(Duration, "#0.0000") & " seconds to run"

End Sub