Excel中具有大型数据集的VBA子例程的速度问题

含咖啡因的迈克

我正在创建一个相当广泛的Excel宏,以帮助捕获文件上的常见错误,然后再将其导入到我们公司的系统中。经过大约一个月的开发,我已经将大部分功能编码到多个Sub(为了便于维护)中,我从主Sub中调用了该功能Alfred()

Sub Alfred() 'the butler 

    Application.ScreenUpdating = False
     Call fileCheck       '  0.57 seconds for 15000 rows
     Call symbolCheck     ' 31.57 seconds for 15000 rows
     Call trimTheHedges   ' 16.21 seconds for 15000 rows
     Call ctdCheck        '  0.28 seconds for 15000 rows
     Call lengthCheck     '  2.21 seconds for 15000 rows
     Call dupKeywordCheck '  0.54 seconds for 15000 rows
     Call colorCheck      '  2.56 seconds for 15000 rows
     Call PRTCheck        '  0.65 seconds for 15000 rows
     Call lminCheck       '139.26 seconds for 15000 rows <- See if we can decrease this and make one for RUSH too
     Call colOpNaCheck    '  0.80 seconds for 15000 rows
     Call colAddCLCheck   '  0.77 seconds for 15000 rows
     Call prodNumCheck    '  1.15 seconds for 15000 rows
     Call bpCheck         '  4.85 seconds for 15000 rows
     Call ucCheck         ' 10.75 seconds for 15000 rows
''''''''''''''''''''''''''''''''''''''''''''''
'''''Total 3.4992 minutes''209.95 seconds'''''
''''''''''''''''''''''''''''''''''''''''''''''
    Application.ScreenUpdating = True
End Sub

在对每个Sub进行计时之后,我意识到我的一个Subs需要很长时间才能完成(Sub lminCheck)。我希望有人可能对如何更好地完成在此特定Sub上执行的任务有所了解。如果可以使用可以加快此任务速度的任何方法,请提供示例(尽可能具体地提供)。我已经关闭ScreenUpdating并且不确定将“计算”转换为xlCalculationManual会很有用(也许我错了吗?),但是我确实在寻找一种方法来重组我的代码(也许使用数组,更好的编码实践等)。 ),这将改善我的Sub的处理时间。

'Checks for LMIN:Y Upcharge Criteria and checks off
'LMIN column of products where LMIN:Y exists
'Run this sub after sub that checks for empty criteria 1/invalid upcharges
'Columns CT & CU are Upcharge Criteria 1 & 2 and Column CP is LMIN
Private Sub lminCheck()

Dim endRange As Integer
Dim usedRange As Range
Dim row As Integer
Dim totalCount As Integer
Dim xid As String
Dim mainProdLine As String

endRange = ActiveSheet.Cells(Rows.count, "CS").End(xlUp).row
Set usedRange = ActiveSheet.Range("CT2:CU" & endRange)

'Count how many times LMIN:Y Upcharge criteria appears in Upcharge 1 & 2 columns
totalCount = WorksheetFunction.CountIf(usedRange, "*LMIN:Y*")

If totalCount <> 0 Then
    Dim lminCount As Integer
    For lminCount = 1 To totalCount
        'This gives us the row of this occurance
        row = Find_nth(usedRange, "LMIN:Y", lminCount)
        'Using row we can look at Column A of the same row to get the XID of the product
        xid = ActiveSheet.Range("A" & row).Value
        'Once we have the xid we can find the main/first line of the product
        Dim tempRange As Range
        Set tempRange = ActiveSheet.Range("A2:A" & endRange)
        mainProdLine = Find_nth(tempRange, xid, 1)
        'Using the main/first line of the product we can now check if the LMIN column is checked
        If ActiveSheet.Range("CP" & mainProdLine).Value <> "Y" Then
            'If column is not checked then check it
            ActiveSheet.Range("CP" & mainProdLine).Value = "Y"
        End If
    Next lminCount
Else
    'Exit entire sub since there are no instances of LMIN:Y to check
    Exit Sub
End If

End Sub

'This is the modified version of the Find_nth Function that is also able to find values if they are in the beginning of a string
Function Find_nth(rng As Range, strText As String, occurence As Integer)
Dim c As Range
Dim counter As Integer
For Each c In rng
    If c.Value = strText Then counter = counter + 1
    If InStr(1, c, strText) = 1 And c.Value <> strText Then counter = counter + 1
    If InStr(1, c, strText) > 1 Then counter = counter + 1
    If counter = occurence Then
        Find_nth = c.row
        '.Address(False,False) eliminates absolute reference ($x$y)
        Exit Function
    End If
Next c
End Function
用户4039065

您有很多重复的循环。为什么在工作表的“匹配”功能如此出色的情况下循环遍历所有单元格,直到找到匹配项

Private Sub lminCheck()
    Dim c As Long, vCOLs As Variant
    Dim rLMINY As Range, vXID As Variant, dXIDs As Object

    Debug.Print Timer
    'application.screenupdating = false '<~~ uncomment this once you are no longer debugging
    Set dXIDs = CreateObject("Scripting.Dictionary")
    dXIDs.comparemode = vbTextCompare

    vCOLs = Array(98, 99)  '<~~ columns CT & CU

    With Worksheets("Upcharge") '<~~ surely you know what worksheet you are supposed to be on
        If .AutoFilterMode Then .AutoFilterMode = False
        For c = LBound(vCOLs) To UBound(vCOLs)
            With Intersect(.UsedRange, .Columns(vCOLs(c)))
                .AutoFilter field:=1, Criteria1:="*LMIN:Y*"
                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        For Each rLMINY In .SpecialCells(xlCellTypeVisible)
                            dXIDs.Item(rLMINY.Offset(0, -(vCOLs(c) - 1)).Value2) = rLMINY.Value2
                        Next rLMINY
                    End If
                End With
                .AutoFilter
            End With
        Next c

        For Each vXID In dXIDs.keys
            .Cells(Application.Match(vXID, .Columns(1), 0), "CP") = "Y"
        Next vXID
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

    dXIDs.RemoveAll: Set dXIDs = Nothing
    Application.ScreenUpdating = True
    Debug.Print Timer

End Sub

屏幕更新打开时,具有10%匹配项的15,000行样本数据耗时0.4秒,而屏幕更新关闭了0.2秒。

本文收集自互联网,转载请注明来源。

如有侵权,请联系[email protected] 删除。

编辑于
0

我来说两句

0条评论
登录后参与评论

相关文章

来自分类Dev

Excel中具有大型数据集的VBA子例程的速度问题

来自分类Dev

如果在大型数据集上使用Excel VBA循环,执行速度会非常慢,然后崩溃

来自分类Dev

Excel如何将具有相同ID号的所有行合并到一个大型数据集的一列中?

来自分类Dev

Excel VBA在数组中存储函数或子例程

来自分类Dev

有关过滤大型数据集的问题

来自分类Dev

MVC EF和具有复杂查询的大型数据集

来自分类Dev

具有大型数据集和多个维度的DC js

来自分类Dev

具有大型数据集的半径内的点数 - R

来自分类Dev

使用参数调用Excel VBA子例程

来自分类Dev

VBA EXCEL:如何在另一个子例程中调用一个子例程?

来自分类Dev

带有大型数据集示例的Blazorise Datagrid中的聚合

来自分类Dev

使用不包含零的Vlookup或IndexMatch中具有增量列的大型excel数据表提取数据

来自分类Dev

大型数据集的JQuery Datatables makeEditable()问题

来自分类Dev

VBA在OnAction中包含子例程的参数

来自分类Dev

R:具有2个大型数据集的模式匹配财务时间序列数据:

来自分类Dev

R:具有2个大型数据集的模式匹配财务时间序列数据:

来自分类Dev

在R中具有多个模拟条件的子帧数据集

来自分类Dev

如何在Excel VBA中的子例程之间传递范围变量

来自分类Dev

如何在excel vba中获取子例程以返回某些内容?

来自分类Dev

有效地广播具有多个变量的大型数据集

来自分类Dev

如何有效地训练具有大型图像数据集的 CNN 模型

来自分类Dev

Perl包在脚本文件中定义,如何具有包导出子例程?

来自分类Dev

具有大型数据集的组件仅在IE11 / Edge上运行缓慢

来自分类Dev

具有大型数据集的DC和交叉滤波器

来自分类Dev

使用公式对具有设置结构的大型数据集进行转置

来自分类Dev

在VBA中具有多个条件的Excel表中查找数据

来自分类Dev

Excel VBA模块子例程未通过参数获取

来自分类Dev

将大型R数据集导出到excel的有效方法

来自分类Dev

Qt中的大型实时数据集

Related 相关文章

  1. 1

    Excel中具有大型数据集的VBA子例程的速度问题

  2. 2

    如果在大型数据集上使用Excel VBA循环,执行速度会非常慢,然后崩溃

  3. 3

    Excel如何将具有相同ID号的所有行合并到一个大型数据集的一列中?

  4. 4

    Excel VBA在数组中存储函数或子例程

  5. 5

    有关过滤大型数据集的问题

  6. 6

    MVC EF和具有复杂查询的大型数据集

  7. 7

    具有大型数据集和多个维度的DC js

  8. 8

    具有大型数据集的半径内的点数 - R

  9. 9

    使用参数调用Excel VBA子例程

  10. 10

    VBA EXCEL:如何在另一个子例程中调用一个子例程?

  11. 11

    带有大型数据集示例的Blazorise Datagrid中的聚合

  12. 12

    使用不包含零的Vlookup或IndexMatch中具有增量列的大型excel数据表提取数据

  13. 13

    大型数据集的JQuery Datatables makeEditable()问题

  14. 14

    VBA在OnAction中包含子例程的参数

  15. 15

    R:具有2个大型数据集的模式匹配财务时间序列数据:

  16. 16

    R:具有2个大型数据集的模式匹配财务时间序列数据:

  17. 17

    在R中具有多个模拟条件的子帧数据集

  18. 18

    如何在Excel VBA中的子例程之间传递范围变量

  19. 19

    如何在excel vba中获取子例程以返回某些内容?

  20. 20

    有效地广播具有多个变量的大型数据集

  21. 21

    如何有效地训练具有大型图像数据集的 CNN 模型

  22. 22

    Perl包在脚本文件中定义,如何具有包导出子例程?

  23. 23

    具有大型数据集的组件仅在IE11 / Edge上运行缓慢

  24. 24

    具有大型数据集的DC和交叉滤波器

  25. 25

    使用公式对具有设置结构的大型数据集进行转置

  26. 26

    在VBA中具有多个条件的Excel表中查找数据

  27. 27

    Excel VBA模块子例程未通过参数获取

  28. 28

    将大型R数据集导出到excel的有效方法

  29. 29

    Qt中的大型实时数据集

热门标签

归档