从列中查找值并快速返回其单元格的行号

Question

是)我有的

我有一个包含零件号的文件和每个零件的几个供应商.共有1500个零件,每个零件有20个可能的供应商.为简单起见,我们假设部件列在A列中,每个供应商在此之后占据一列.供应商下的值是手动输入的,但并不重要.

在另一个工作表中,我有一个从Access数据库导入的部件列表.导入零件清单,但不导入供应商信息.在这两种情况下,每个部分只出现一次.

我想做的事

我只想将第一张表中的供应商信息与导入列表中的部件相匹配.现在,我有一个功能,它通过供应商遍历列表中的每个部分,将供应商信息复制到一个数组中,在导入的部件列表中找到部件号(总是有一个唯一匹配)并将数组复制到它旁边(内有供应商信息).有用.不幸的是,每次使用它时,find函数都会显着减慢.我知道它是通过各种测试的罪魁祸首,我无法理解为什么它减慢速度(从每秒200次循环迭代开始,减慢到每秒1次并且Excel崩溃).我可能有某种泄漏？文件大小始终为7mb.这里是:

Function LigneNum(numAHNS As String) As Integer
    Dim oRange As Range, aCell As Range
    Dim SearchString As String

    Set oRange = f_TableMatrice.Range("A1:A1500")
    SearchString = numAHNS

    Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        'We have found the number by now:
            LigneNum = aCell.Row
        Exit Function
    Else
        MsgBox "Un numéro AHNS n'a pas été trouvé: " & SearchString
        Debug.Print SearchString & " not found!"
            LigneNum = 0
        Exit Function
    End If

End Function

该函数只返回找到该值的行号,如果找不到应该永远不会发生的行号,则返回0.

我需要帮助的是什么

我想要找出减速的​​原因,或者找到Find方法的替代品.我之前使用过Find,这是第一次发生在我身上.它最初来自Siddarth Rout的网站:http://www.siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba/奇怪的是它起步不慢,它随着它的继续变得迟钝.

我认为使用Match可以工作,或者可能将搜索范围(部件号)转储到数组中并尝试将这些与导入的部件号列表相匹配可能有效.我不确定该怎么做,但我的问题更多的是关于哪一个会更快(只要它不到15秒我不在乎,但是,从表单中循环超过1500项1500次是出于问题).有人建议匹配阵列解决方案/花更多时间修复我的代码吗？

编辑

这是从它调用的循环.我不认为这是有问题的:

For Each cellToMatch In rngToMatch
        Debug.Print cellToMatch.Row
        'The cellsToMatch's values are the numbers I want, rngToMatch is the column where they are.

        For i = 2 To nbSup + 1
            infoSup(i - 2) = f_TableMatrice.Cells(cellToMatch.Row, i)
        Next
        'infoSup contains the required supplier data now
        'I call the find function here to find the row where the number appears in the imported sheet
        'To copy the array nbSup on that line
        LigneAHNS = LigneNum(cellToMatch.Value) 'This is the Find function
        If LigneAHNS = 0 Then Exit Sub
        'This loop just empties the array in the right line.
        For i = LBound(infoSup) To UBound(infoSup)
            f_symix.Cells(LigneAHNS, debutsuppliers + i) = infoSup(i)
        Next

    Next

例如,如果我用LigneAHNS = 20替换LigneAHNS = LigneNum,代码执行速度非常快.泄漏因此来自查找功能本身.

Answer 1

另一种不使用 find 函数的方法可能是这样的。首先，将部件 ID 及其行号放入脚本字典中。这些确实可以快速查找。像这样：

Dim Dict As New Scripting.Dictionary
Dim ColA As Variant
Lastrow=range("A50000").end(xlUp).Row
ColA = Range("A1:A" & LastRow).Value
For i = 1 To LastRow
    Dict.Add ColA(i, 1), i
Next i

为了进一步优化，您可以将 Dict 声明为公共变量，填充一次，然后在查找中多次引用它。我预计这会比每次查找时运行 cells.find 更快。

有关在字典中查找项目的语法，请参阅使用索引/项目编号循环遍历 Scripting.Dictionary