[已解决]提高for循环速度

13591163120

做了一个宏，for循环内列为固定值时，循环时间为2秒
因为需要，把行、列更改为变量值，循环时间增加到2分钟
又加入求和公式后，循环时间再度延迟。
表格压缩后大于1MB没法上传，唉。部品明细表：有两万行数据，生产计划表：有500行，
诉求：优化代码，提高效率
备注：接触VBA一周的新人，不许笑话人。

Sub 导入生产计划()
    Dim arr1, arr2, i As Long, j As Long, sText As Date, bText As Date
    Application.ScreenUpdating = False '关屏幕刷新
    Application.DisplayAlerts = False '关警告信息
    行 = Sheets("生产计划").Range("A:A").EntireRow.Find("产品编码", LookAt:=xlWhole).Row '定位生产计划查询起始点
    列1 = Sheets("生产计划").Range("a" & 行).End(xlToRight).Column
    Sheets("生产计划").Activate
    While 列1 > 0     '如果条件为真时执行下列代码
           If Cells(21, 列1) = "合计" Or Cells(21, 列1) = "总合计" Then Columns(列1).Delete
                        列1 = 列1 - 1

    Wend
        Sheets("部品明细").Range("j1").Resize(20000, 50).ClearContents   '清空上次导入结果
        用户输入 = InputBox("起始日期：")
            sText = 用户输入
            Set k = Sheets("生产计划").Range("a" & 行).EntireRow.Find(sText, LookAt:=xlWhole)
            If k Is Nothing Then
            MsgBox "请确认日期是否正确"
            Exit Sub
            Else
            k = Sheets("生产计划").Range("a" & 行).EntireRow.Find(sText, LookAt:=xlWhole).Column
            End If

                列1 = Sheets("生产计划").Range("a" & 行).End(xlToRight).Column
                arr1 = Sheets("生产计划").Range("a" & 行 + 2 & ":a" & Sheets("生产计划").Range("a" & 行 + 2).End(xlDown).Row)
                arr2 = Sheets("部品明细").Range("f2:bc" & Sheets("部品明细").Range("f2").End(xlDown).Row)
                Sheets("部品明细").Range(Sheets("部品明细").Cells(1, "J"), Sheets("部品明细").Cells(1, 列1 - k + 10)) = Sheets("生产计划").Range(Sheets("生产计划").Cells(行, k), Sheets("生产计划").Cells(行, 列1)).Value
                Sheets("部品明细").Rows("1:1").NumberFormatLocal = "m/d;@"
                    For i = 1 To UBound(arr1, 1)
                        For j = 1 To UBound(arr2, 1)
                            If arr2(j, 1) = arr1(i, 1) Then
                             Sheets("部品明细").Range(Sheets("部品明细").Cells(j + 1, "J"), Sheets("部品明细").Cells(j + 1, 列1 - k + 10)) = Sheets("生产计划").Range(Sheets("生产计划").Cells(i + 2, k), Sheets("生产计划").Cells(i + 2, 列1)).Value  '行、列 转换为变量后，循环速度变慢
                             Sheets("部品明细").Range("H" & j + 1) = "=SUM(RC[2]:RC[" & 列1 & "])"  '加入运算后，循环速度进一步变慢
                             End If
                        Next j
                    Next i
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

最佳答案

月排行榜 / 总排行榜

砂海

2021-12-24 21:22

1) 用数组 一次性 操作
Sub ccc()
    Dim arr(1 To 3)
    arr(1) = 2
    arr(2) = 3

    If arr(1) > arr(2) Then
        arr(3) = "=rc[-2]*rc[-1]"
    Else
        arr(3) = "=rc[-2]/rc[-1]"
    End If

    Range("A1:C1") = arr
End Sub

2) range() 比 cells() 运行效率高
3) range.value  比 range 运行效率高 ' .formula  .formular1c1 同理
4) 用 With 语句
5) 代码 缩进 不对 , 参见 上面的示例
6) 附件数据无需这么多 , 哪怕10行20行  , 说一声 实际上万行就可以

跳转到最佳答案楼层

hfwufanhf2006

最简单的办法就是改用数组，我只能提供一个步骤模型：
1、先把源数据全部装入数组，如果有多个数据源，每个区域分别对应一个数组：
     dim arr      '定义了两个数组，分别对应两个数据源
     dim brr
     arr=range("数据源区域1")
     brr=range("数据源区域2")
     单元格区域数据装入数组后，数组是一个二维的数组，切记，即使只有一个单元格，也是二维的；

2、对数组进行循环
     for i=1 to ubound(arr)
         for j=1 to ubound(brr)
              rem 计算结果可以先临时存放在第三个数组中，也可以直接写入单元格，前者更快点
         next j
     next i
     注意：如果要使用临时数组存放结果，最好定义一个静态的二维数组，因为动态数组只能增加第二维，不能增加第一维，这就增加很大的麻烦，很多人会使用变通的转置，不过也有隐患，转置是有最大上限限制的，好像是4000，转置对新手也不容易理解，我自己也不用。对比静态数组，静态数组的劣势是不知道该定义多大的数组，我通常会定义一个足够使用的数组，比如 crr(1 to 10000,1 to 20)，1万行20列的数组，当然你最好先对自己的数据大小有个合理的判断，过大的数组会浪费内存空间。
     在静态数组模式下，还需要有一个计数器，用来记录实际存放了有效数据的最大行数；

3、最后就是回写数据，把数组的结果写到单元格区域中：
     把crr写入起始单元格d20，假设行计数器是js：
     range("d20").resize(js,20)=crr

4、如果你对数组不太熟，存放数据的数组crr就别要了，直接把计算结果放在单元格也行，速度瞒不了多少。你这个问题最影响速度的对单元格进行双层循环，所以只要源数据装入了数组，速度就能得到很大改善，而把结果先放入数组最后再集中写入单元格只是锦上添花，这一步不是关键；

13591163120

hfwufanhf2006 发表于 2021-12-24 17:01
最简单的办法就是改用数组，我只能提供一个步骤模型：
1、先把源数据全部装入数组，如果有多个数据源，每 ...

前辈：你说的 （具体是哪步出现纰漏了，我还是没太理解）第一步   把数据源先装入数组，在我的代码中我有做了。就是下列两行！！！
arr1 = Sheets("生产计划").Range("a" & 行 + 2 & ":a" & Sheets("生产计划").Range("a" & 行 + 2).End(xlDown).Row)
arr2 = Sheets("部品明细").Range("f2:bc" & Sheets("部品明细").Range("f2").End(xlDown).Row)

第二部   循环数组
For i = 1 To UBound(arr1, 1)
                        For j = 1 To UBound(arr2, 1)
                            If arr2(j, 1) = arr1(i, 1) Then
                             Sheets("部品明细").Range(Sheets("部品明细").Cells(j + 1, "J"), Sheets("部品明细").Cells(j + 1, 列1 - k + 10)) = Sheets("生产计划").Range(Sheets("生产计划").Cells(i + 2, k), Sheets("生产计划").Cells(i + 2, 列1)).Value  '行、列 转换为变量后，循环速度变慢
                             Sheets("部品明细").Range("H" & j + 1) = "=SUM(RC[2]:RC[" & 列1 & "])"  '加入运算后，循环速度进一步变慢
                             End If
                        Next j
                    Next i
        

林木水

13591163120 发表于 2021-12-24 18:01
前辈：你说的 （具体是哪步出现纰漏了，我还是没太理解）第一步   把数据源先装入数组，在我的代码中我有 ...

优化速度方面考虑：
1.减少对象使用，比如单元格、调用字典、调用其他等等，能用数组优先考虑
2.减少Application函数使用，能用VBA函数优先考虑
3.dim 参数尽量给参数定义

砂海

1) 用数组 一次性 操作
Sub ccc()
    Dim arr(1 To 3)
    arr(1) = 2
    arr(2) = 3

    If arr(1) > arr(2) Then
        arr(3) = "=rc[-2]*rc[-1]"
    Else
        arr(3) = "=rc[-2]/rc[-1]"
    End If

    Range("A1:C1") = arr
End Sub

2) range() 比 cells() 运行效率高
3) range.value  比 range 运行效率高 ' .formula  .formular1c1 同理
4) 用 With 语句
5) 代码 缩进 不对 , 参见 上面的示例
6) 附件数据无需这么多 , 哪怕10行20行  , 说一声 实际上万行就可以

砂海

    Application.Calculation = xlManual                '单元格 手动重算

    Application.Calculation = xlAutomatic        '单元格 自动重算

13591163120

砂海 发表于 2021-12-24 21:26
Application.Calculation = xlManual                '单元格 手动重算

    Application.Calculation = xlAutomati ...

谢谢回复，明天我尝试修改一下代码。