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

Question

What I have

I have a file with part numbers and several suppliers for each part. There are 1500 parts with around 20 possible suppliers each. For the sake of simplicity let's say parts are listed in column A, with each supplier occupying a column after that. Values under the suppliers are entered manually but don't really matter.

In another sheet, I have a list of parts that is imported from an Access database. The parts list is imported, but not the supplier info. In both cases, each part appears only once.

What I want to do

I simply want to match the supplier info from the first sheet with the parts in the imported list. Right now, I have a function which goes through each part in the list with suppliers, copies the supplier information in an array, finds the part number in the imported part list (there is always a unique match) and copies the array next to it (with supplier info inside). It works. Unfortunately, the find function slows down considerably each time it is used. I know it is the culprit through various tests, and I can't understand why it slows down (starts at 200 loop iterations per second, slows down to 1 per second and Excel crashes) . I may have a leak of some sort? The file size remains 7mb throughout. Here it is:

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

The function simply returns the row number on which the value is found, or 0 if it doesn't find it which should never happen.

What I need help with

I'd like either to identify the cause of the slow down, or find a replacement for the Find method. I have used the Find before and it is the first time this happens to me. It was initially taken from Siddarth Rout's website: http://www.siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba/ What is strange is that it doesn't start slow, it just becomes sluggish as it goes on.

I think using Match could work, or maybe dumping the range to search (the part numbers) into an array and trying to match these with the imported parts number list could work. I am unsure how to do it, but my question is more about which one would be faster (as long as it remains under 15 seconds I don't really care, though, but looping over 1500 items 1500 times right out of the sheet is out of the question). Would anyone suggest match over the array solution / spending more hours fixing my code?

EDIT

Here is the loop it is being called from. I don't think it is problematic:

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

If I replace LigneAHNS = LigneNum by LigneAHNS = 20, for example, the code executes extremely fast. The leak therefore comes from the find function itself.

Answer 1

Another way to do it without using the find function might be something like this. Firstly, put the part IDs and their line numbers into a scripting dictionary. These are really quick to lookup from. Like this:

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

To further optimise, you could declare the Dict as a public variable, populate it once, and refer to it many times in your lookups. I expect this would be faster than running a cells.find over a range every time you do a lookup.

For syntax of looking up items in the dictionary, refer to Looping through a Scripting.Dictionary using index/item number

Answer 2

You could achieve this with only Excel cell formulas and no VB if you are willing to devote a separate column to each supplier on your main parts sheet. You could then use conditional formatting to make it more visually appealing. I've tried it with 1500 rows and it's very quick. Increasing it to 5000 rows becomes noticeably slower, but you say you have only 1500 rows for now, so it should be suitable.

• On Sheet 1, define a part number column and a separate column for each supplier .
• Create a separate sheet for each supplier with all part numbers available from that supplier listed in column A. Make sure the rows on the supplier sheets are ordered by part number.
• Name each of the supplier sheets the same as the associated column heading shown on Sheet 1.

• Assign the following formula in each cell beneath each supplier column heading on Sheet 1:

  =NOT(ISNA(VLOOKUP($A2,INDIRECT("'"&B$1&"'!A:A"),1,FALSE)))

The following screen cap shows this implemented along with conditional formatting to highlight which suppliers have which parts:

If you wanted to show quantities available from suppliers, then you could always have a second column (B) on the supplier sheets containing last known quantities for each part and use VLOOKUP to retrieve column B instead of A.