Question

大家好，我们先介绍一下我项目的简要介绍，然后我将跟进我的具体问题和代码。

目前我正在构建一个程序来自动填充模板的过程。这个模板经常超过60,000行数据，我通过插入新的数据表并运行它来构建大部分数据来逐月工作。目前，所有工作都基于一个数据表，我手动导入到Excel中。此数据表不包含填充模板所需的所有数据，因此现在我开始引入其他数据来补充这一点。这里的问题在于数据关联。当我最初从一个数据表中提取数据时，我不必担心我为每一行提取的数据是否与其他行一致，因为它们都来自同一张纸。现在我必须跨两张纸交叉检查数据以确认它正在提取正确的信息。

现在你需要知道什么。我正在尝试填充一个将被称为Haircut的列，但在我这样做之前，我需要确认我正在将正确的理发数与相关的商业ID相关联，该商品ID已经填充到前一行的模板中代码。

使用我在整个项目中使用的类似逻辑，这是我必须执行此任务的一段代码。

    Dim anvil as Worksheet
    Dim ALLCs as worksheet
    Dim DS as worksheet
    '''''''''''''''''''''''''''''code above this line is irrelevant to answer this question
    ElseIf InStr(1, DS.Cells(x, 2), "Haircut") Then
    Anvil.Select
        For y = 1 To 80
            If Anvil.Cells(1, y) = "Haircut" Then
                For Z = 1 To 80
                    If Anvil.Cells(1, Z) = "Trade ID" Then
                        For t = 2 To 70000
                            For u = 16 To 70000
                                If Anvil.Cells(t, Z) = ALLCs.Cells(u, 34) Then
                                ALLCs.Cells(u, 27) = Anvil.Cells(t, y)
                                End If
                            Next
                        Next
                    End If
                Next
            End If
        Next

这段代码加上我的其他代码，我认为理论上是可行的，但我只能想象它需要一段难以置信的时间（这个程序已经花了7分半钟才能运行）。有关如何使用更好的功能重写此代码的任何建议，遵循这个一般逻辑吗？

无论您是完全修改代码，还是提供有关如何减少循环的建议，我们都将不胜感激。除了屏幕更新和计算建议之外，我还在寻找加速代码的建议。

Answer 1

如果我正确理解了逻辑，那么你可以使用.Find()方法替换除了其中一个循环之外的所有循环：

'// Dimension range objects for use
Dim hdHaricut As Excel.Range
Dim hdTradeID As Excel.Range
Dim foundRng As Excel.Range

With Anvil
    With .Range("A1:A80") '// Range containing headers
        '// Find the cell within the above range that contains a certain string, if it exists set the Range variable to be that cell.
        Set hdHaircut = .Find(What:="Haircut", LookAt:=xlWhole)
        Set hdTradeID = .Find(What:="Trade ID", LookAt:=xlWhole)
    End With
    '// Only if BOTH of the above range objects were found, will the following block be executed.
    If Not hdHaricut Is Nothing And Not hdTradeID Is Nothing Then
        For t = 2 To 70000
            '// Using the .Column property of the hdTradeID range, we can see if the value of Cells(t, hdTradeColumn) exists 
            '// in the other sheet by using another .Find() method.
            Set foundRng = ALLCs.Range(ALLCs.Cells(16, 34), ALLCs.Cells(70000, 34)).Find(What:=.Cells(t, hdTradeID.Column).Value, LookAt:=xlWhole)
            '// If it exists, then pass that value to another cell on the same row
            If Not foundRng Is Nothing Then ALLCs.Cells(foundRng.Row, 27).Value = .Cells(t, hdHaircut.Column).Value
            '// Clear the foundRng variable from memory to ensure it isn't mistaken for a match in the next iteration.
            Set foundRng = Nothing
        Next
    End If
End With

压缩主要（不实用）基于循环的VBA代码;嵌套For ... Next循环

1 个答案: