当前位置: 动力学知识库 > 问答 > 编程问答 >

How to improve efficiency using arrays instead of Find in VBA

问题描述:

I have a function that is used to find the information in a Excel worksheet knowing that:

- The Key can be in a variable column

- Variable fields can be searched

Sheets usually have less than a hundred column, but can have anything from a few hundred to 100 000 rows to search. In our biggest files, the function I'm trying to optimize can be used about a million times.

After reading

https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/

... and finding our function used Find (3 times), I tried using arrays.

This is the code I wrote

Function getInfo(Key As String, NameField As String, NameKey As String, WksName As String) As Variant

On Error GoTo Error

Dim iColumnKEY As Integer

Dim iColumnFIELD As Integer

Dim i As Integer

Dim ListFields, ListKeys As Variant

ListFields = Worksheets(WksName).Range("A1:ZZ1")

i = LBound(ListFields, 2)

'To identify which column contains the Key and which one contains the

'information we are searching for

Do While iColumnKEY=0 Or iColumnFIELD=0

If i > UBound(ListFields, 2) Then

getInfo = "//error\\"

ElseIf ListFields(1, i) = NameKey Then

iColumnKEY = i

ElseIf ListFields(1, i) = NameField Then

iColumnFIELD = i

End If

i = i + 1

Loop

Dim iROW As Integer

ListKeys = Worksheets(WksName).Columns(iColumnFIELD)

i = LBound(ListKeys, 1)

Do While iROW=0

If i > UBound(ListKeys,1) Then

getInfo = "//error\\"

ElseIf ListKeys(i,1) = Key Then

iROW = i

End If

i = i + 1

Loop

getInfo = Worksheets(WksName).Cells(iROW, iColumnFIELD)

Exit Function

Error:

getInfo = "//error\\"

End Function

The code works, but is very slow. What am I doing that is slowing things down?

It is not in the code right now, but I did try turning the screen update down, as well as automatic calculation down. I didn't see any difference in speed, which indicates me that the basic algorithm is the main issue.

Also, the article was in 2011. Are arrays still a lot faster than Match/Find?

As a side note: eventually, I'll suggest having a macro that search for a range of Keys in a batch, instead of calling the function for every single key. This would means the first Do... While loop would be done only once for a macro, and only the Do_While for Rows would be run for every key. However, this is not an option in the very short term.

Thanks. Any help or advice would be greatly appreciated.

网友答案:

To find out what parts of the code are the slowest, you can use Timer:

Dim t as Single
t = Timer
' part of the code
Debug.Print CDbl(Timer - t) ' CDbl to avoid scientific notation

Using .Value2 instead of .Value should help a bit:

ListFields = Worksheets(WksName).Range("A1:ZZ1").Value2

Searching for the key and field in two separate loops should be a bit faster because there will be less comparisons. Also, I am not sure if it will be a bit slower or faster, but you can iterate even multi-dimensional arrays:

Dim i As Integer, v ' As Variant
i = 1

For Each v in ListFields 
    If v = NameKey Then
        iColumnKEY = i
        Exit For
    End If
    i = i + 1
Next
网友答案:

In your code you never use iColumnKEY

I think this is what you are actually after:

Function getInfo(key As String, NameField As String, NameKey As String, WksName As String) As Variant

    Dim keyCol As Variant, fieldCol As Variant, keyRow As Variant
    Dim errMsg As String

    getInfo = "//error\\"

    With Worksheets(WksName)
        With Intersect(.UsedRange, .Columns("A:ZZ")) ' <--| reference a range in passed worksheet cells belonging to columns "A" to "ZZ" from worksheet first used row to last used one and from worksheet first used column to last used one
            MsgBox .Address
            fieldCol = Application.Match(NameField, .Rows(1), 0) '<--| look for passed 'NameField' in referenced range
            If IsError(fieldCol) Then
                errMsg = " :field column '" & NameField & "' not found"
            Else
                keyCol = Application.Match(NameKey, .Rows(1), 0) '<--| look for passed 'NameKey' in referenced range
                If IsError(keyCol) Then
                    errMsg = " :key column '" & NameKey & "' not found"
                Else
                    MsgBox .Columns(keyCol).Address
                    keyRow = Application.Match(key, .Columns(keyCol)) '<--| look for passed 'key' in referenced range 'NameKey' column
                    If IsError(keyRow) Then
                        errMsg = " :key '" & key & "' not found in column '" & NameKey & "'"
                    Else
                        getInfo = .Cells(keyRow, fieldCol) '<--| get referenced range "item"
                    End If
                End If
            End If
            If errMsg <> "" Then getInfo = getInfo & errMsg
        End With
    End With
End Function
分享给朋友:
您可能感兴趣的文章:
随机阅读: