返回数组Excel VBA中元素的索引

Posted 2023-02-23

技术标签:

【中文标题】返回数组Excel VBA中元素的索引【英文标题】：Return Index of an Element in an Array Excel VBA 【发布时间】：2011-10-25 06:37:09 【问题描述】：

我有一个数组 prLst，它是一个整数列表。整数未排序，因为它们在数组中的位置代表电子表格上的特定列。我想知道如何在数组中找到一个特定的整数，并返回它的索引。

似乎没有任何资源可以告诉我如何不将数组转换为工作表上的范围。这似乎有点复杂。这对 VBA 来说是不可能的吗？

【问题讨论】：

【参考方案1】：

Dim pos, arr, val

arr=Array(1,2,4,5)
val = 4

pos=Application.Match(val, arr, False)

if not iserror(pos) then
   Msgbox val & " is at position " & pos
else
   Msgbox val & " not found!"
end if

更新为显示使用 Match（带有 .Index）在二维数组的维度中查找值：

Dim arr(1 To 10, 1 To 2)
Dim x

For x = 1 To 10
    arr(x, 1) = x
    arr(x, 2) = 11 - x
Next x

Debug.Print Application.Match(3, Application.Index(arr, 0, 1), 0)
Debug.Print Application.Match(3, Application.Index(arr, 0, 2), 0)

编辑：这里值得说明@ARich 在 cmets 中指出的内容 - 如果您在循环中执行此操作，则使用 Index() 对数组进行切片具有可怕的性能。

在测试中（下面的代码），Index() 方法比使用嵌套循环慢了近 2000 倍。

Sub PerfTest()

    Const VAL_TO_FIND As String = "R1800:C8"
    Dim a(1 To 2000, 1 To 10)
    Dim r As Long, c As Long, t

    For r = 1 To 2000
        For c = 1 To 10
            a(r, c) = "R" & r & ":C" & c
        Next c
    Next r

    t = Timer
    Debug.Print FindLoop(a, VAL_TO_FIND), Timer - t
    ' >> 0.00781 sec

     t = Timer
    Debug.Print FindIndex(a, VAL_TO_FIND), Timer - t
    ' >> 14.18 sec

End Sub

Function FindLoop(arr, val) As Boolean
    Dim r As Long, c As Long
    For r = 1 To UBound(arr, 1)
    For c = 1 To UBound(arr, 2)
        If arr(r, c) = val Then
            FindLoop = True
            Exit Function
        End If
    Next c
    Next r
End Function

Function FindIndex(arr, val)
    Dim r As Long
    For r = 1 To UBound(arr, 1)
        If Not IsError(Application.Match(val, Application.Index(arr, r, 0), 0)) Then
            FindIndex = True
            Exit Function
        End If
    Next r
End Function

【讨论】：

它工作！ +1 我真的不知道可以在 VBA 数组上使用 Match 匹配方法！许多 Excel 工作表函数都有一个类似的表单，可通过 Application.WorksheetFunction.[FunctionName]使用 IsError()。如果您包含 WorksheetFunction 部分，那么（例如）如果 Match() 找不到匹配项，它将抛出一个错误，您需要使用错误处理程序来捕获该错误。整洁！ match 也适用于多维数组吗？ @H3lue 很难说没有实际代码你的问题是什么。另外，您甚至没有提及您尝试使用哪个版本... @TimWilliams 很抱歉在这么长时间之后拖累了这个......我只是想向未来的读者指出，在我所做的一些测试中，返回一个像 @987654325 这样的“行”引用上面的@ 方法确实如此，使用常规的Do While 循环要快得多（大约快530%）。上面概述的方法在某些情况下仍然非常有用，但如果时间很紧迫，我建议使用循环。【参考方案2】：

变体数组：

    Public Function GetIndex(ByRef iaList() As Variant, ByVal value As Variant) As Long

    Dim i As Long

     For i = LBound(iaList) To UBound(iaList)
      If value = iaList(i) Then
       GetIndex = i
       Exit For
      End If
     Next i

    End Function

最快的整数版本（如下所示）

    Public Function GetIndex(ByRef iaList() As Integer, ByVal value As Integer) As Integer
     Dim i As Integer

     For i = LBound(iaList) To UBound(iaList)
      If iaList(i) = value Then: GetIndex = i: Exit For:
     Next i

    End Function

' a snippet, replace myList and myValue to your varible names: (also have not tested)

一个 sn-p，让我们测试通过引用作为参数传递的假设意味着什么。（答案是否定的）使用它将 myList 和 myValue 替换为您的变量名：

  Dim found As Integer, foundi As Integer ' put only once
  found = -1
  For foundi = LBound(myList) To UBound(myList):
   If myList(foundi) = myValue Then
    found = foundi: Exit For
   End If
  Next
  result = found

为了证明这一点，我做了一些基准测试

结果如下：

---------------------------
Milliseconds
---------------------------
result0: 5 ' just empty loop

result1: 2702  ' function variant array

result2: 1498  ' function integer array

result3: 2511 ' snippet variant array

result4: 1508 ' snippet integer array

result5: 58493 ' excel function Application.Match on variant array

result6: 136128 ' excel function Application.Match on integer array
---------------------------
OK   
---------------------------

一个模块：

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

    Public Function GetIndex1(ByRef iaList() As Variant, ByVal value As Variant) As Long

    Dim i As Long

     For i = LBound(iaList) To UBound(iaList)
      If value = iaList(i) Then
       GetIndex = i
       Exit For
      End If
     Next i

    End Function


'maybe a faster variant for integers

    Public Function GetIndex2(ByRef iaList() As Integer, ByVal value As Integer) As Integer
     Dim i As Integer

     For i = LBound(iaList) To UBound(iaList)
      If iaList(i) = value Then: GetIndex = i: Exit For:
     Next i

    End Function

' a snippet, replace myList and myValue to your varible names: (also have not tested)



    Public Sub test1()
     Dim i As Integer

     For i = LBound(iaList) To UBound(iaList)
      If iaList(i) = value Then: GetIndex = i: Exit For:
     Next i

    End Sub


Sub testTimer()

Dim myList(500) As Variant, myValue As Variant
Dim myList2(500) As Integer, myValue2 As Integer
Dim n

For n = 1 To 500
myList(n) = n
Next

For n = 1 To 500
myList2(n) = n
Next

myValue = 100
myValue2 = 100


Dim oPM
Set oPM = New PerformanceMonitor
Dim result0 As Long
Dim result1 As Long
Dim result2 As Long
Dim result3 As Long
Dim result4 As Long
Dim result5 As Long
Dim result6 As Long

Dim t As Long

Dim a As Long

a = 0
Dim i
't = GetTickCount
oPM.StartCounter
For i = 1 To 1000000

Next
result0 = oPM.TimeElapsed() '  GetTickCount - t

a = 0

't = GetTickCount
oPM.StartCounter
For i = 1 To 1000000
a = GetIndex1(myList, myValue)
Next
result1 = oPM.TimeElapsed()
'result1 = GetTickCount - t


a = 0

't = GetTickCount
oPM.StartCounter
For i = 1 To 1000000
a = GetIndex2(myList2, myValue2)
Next
result2 = oPM.TimeElapsed()
'result2 = GetTickCount - t



a = 0

't = GetTickCount

oPM.StartCounter
Dim found As Integer, foundi As Integer ' put only once
For i = 1 To 1000000
found = -1
For foundi = LBound(myList) To UBound(myList):
 If myList(foundi) = myValue Then
  found = foundi: Exit For
 End If
Next
a = found
Next
result3 = oPM.TimeElapsed()
'result3 = GetTickCount - t



a = 0

't = GetTickCount

oPM.StartCounter
For i = 1 To 1000000
found = -1
For foundi = LBound(myList2) To UBound(myList2):
 If myList2(foundi) = myValue2 Then
  found = foundi: Exit For
 End If
Next
a = found
Next
result4 = oPM.TimeElapsed()
'result4 = GetTickCount - t


a = 0

't = GetTickCount
oPM.StartCounter
For i = 1 To 1000000
a = pos = Application.Match(myValue, myList, False)
Next
result5 = oPM.TimeElapsed()
'result5 = GetTickCount - t



a = 0

't = GetTickCount
oPM.StartCounter
For i = 1 To 1000000
a = pos = Application.Match(myValue2, myList2, False)
Next
result6 = oPM.TimeElapsed()
'result6 = GetTickCount - t


MsgBox "result0: " & result0 & vbCrLf & "result1: " & result1 & vbCrLf & "result2: " & result2 & vbCrLf & "result3: " & result3 & vbCrLf & "result4: " & result4 & vbCrLf & "result5: " & result5 & vbCrLf & "result6: " & result6, , "Milliseconds"
End Sub

一个名为 PerformanceMonitor 的类

Option Explicit

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double

Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#

Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
    Low = LI.lowpart
    If Low < 0 Then
        Low = Low + TWO_32
    End If
    LI2Double = LI.highpart * TWO_32 + Low
End Function

Private Sub Class_Initialize()
Dim PerfFrequency As LARGE_INTEGER
    QueryPerformanceFrequency PerfFrequency
    m_crFrequency = LI2Double(PerfFrequency)
End Sub

Public Sub StartCounter()
    QueryPerformanceCounter m_CounterStart
End Sub

Property Get TimeElapsed() As Double
Dim crStart As Double
Dim crStop As Double
    QueryPerformanceCounter m_CounterEnd
    crStart = LI2Double(m_CounterStart)
    crStop = LI2Double(m_CounterEnd)
    TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
End Property

【讨论】：

我认为糟糕的表现是因为使用变体作为参数。因为预取器效应。即如果所有内存都可以提前读取。就像所有变量都是相同的并且按照它执行良好的顺序读取。如果它使用引用在内存位置跳跃可能会更慢。每次它跳过一个引用时，它都会降低 o(1) 的性能。对于许多参考，它就像 (o(1)+o(1)+o(1)+o(1))*nloop。 variant 是一种封装格式。像 bstr 和安全数组这样的 ole 对象通常是系统内存中进程外部的引用。并动态分配。在记忆中的不同位置。一个安全的数组很容易成为一个引用数组。和变体也可能是对引用的引用。所以根据定义它应该很慢。我猜 excel 函数正在破解系统并针对此类问题进行了优化，并且以某种方式更快地忽略了一些引用并在可能的情况下进行检查我想如果少用几个引用可能会更快。就像参数是简单类型的整数一样。并且变量不会是数组 byref 之类的引用。但是 byval 让它们成为本地副本而不是引用（将参数类型从变体更改为整数，并将 byref 更改为 byval）也可能不使用函数，而是在每个地方使用 sn-p 我做了 pef 测试。实际上性能非常好。因为使用循环而不是使用excel函数。首选项测试还显示，数组的每个函数以及循环中的每个变体都有参考访问成本。似乎excel的匹配会复制一些数据并可能转换为范围。就性能而言，这是昂贵的【参考方案3】：

这是另一种方式：

Option Explicit

' Just a little test stub. 
Sub Tester()

    Dim pList(500) As Integer
    Dim i As Integer

    For i = 0 To UBound(pList)

        pList(i) = 500 - i

    Next i

    MsgBox "Value 18 is at array position " & FindInArray(pList, 18) & "."
    MsgBox "Value 217 is at array position " & FindInArray(pList, 217) & "."
    MsgBox "Value 1001 is at array position " & FindInArray(pList, 1001) & "."

End Sub

Function FindInArray(pList() As Integer, value As Integer)

    Dim i As Integer
    Dim FoundValueLocation As Integer

    FoundValueLocation = -1

    For i = 0 To UBound(pList)

        If pList(i) = value Then

            FoundValueLocation = i
            Exit For

        End If

    Next i

    FindInArray = FoundValueLocation

End Function

【讨论】：

循环查找值？【参考方案4】：

这是你要找的吗？

public function GetIndex(byref iaList() as integer, byval iInteger as integer) as integer

dim i as integer

 for i=lbound(ialist) to ubound(ialist)
  if iInteger=ialist(i) then
   GetIndex=i
   exit for
  end if
 next i

end function

【讨论】：

【参考方案5】：

注意数组是从零开始还是从一开始。此外，当函数返回位置 0 或 1 时，请确保不会将其与函数返回的 True 或 False 混淆。

Function array_return_index(arr As Variant, val As Variant, Optional array_start_at_zero As Boolean = True) As Variant

Dim pos
pos = Application.Match(val, arr, False)

If Not IsError(pos) Then
    If array_start_at_zero = True Then
        pos = pos - 1
        'initializing array at 0
    End If
   array_return_index = pos
Else
   array_return_index = False
End If

End Function

Sub array_return_index_test()
Dim pos, arr, val

arr = Array(1, 2, 4, 5)
val = 1

'When array starts at zero
pos = array_return_index(arr, val)
If IsNumeric(pos) Then
MsgBox "Array starting at 0; Value found at : " & pos
Else
MsgBox "Not found"
End If

'When array starts at one
pos = array_return_index(arr, val, False)
If IsNumeric(pos) Then
MsgBox "Array starting at 1; Value found at : " & pos
Else
MsgBox "Not found"
End If



End Sub

【讨论】：

【参考方案6】：

'To return the position of an element within any-dimension array  
'Returns 0 if the element is not in the array, and -1 if there is an error  
Public Function posInArray(ByVal itemSearched As Variant, ByVal aArray As Variant) As Long  
Dim pos As Long, item As Variant  

posInArray = -1  
If IsArray(aArray) Then  
    If not IsEmpty(aArray) Then  
        pos = 1  
        For Each item In aArray  
            If itemSearched = item Then  
                posInArray = pos  
                Exit Function  
            End If  
            pos = pos + 1  
        Next item  
        posInArray = 0  
    End If  
End If

End Function

【讨论】：

【参考方案7】：

我可以做到这一点的唯一方法（尽管很麻烦但又方便/相对快速）是连接任意维数组，并将其减少为一维，使用 "/[column number]//\| "作为分隔符。

& 在此一维列上使用单单元格结果多重查找宏函数。

& 然后索引匹配以提取位置。（使用多个查找匹配）

这样您就可以在原始任意维度数组中获得您要查找的元素/字符串的所有匹配项及其位置。在一个单元格中。

希望我可以为整个过程编写一个宏/函数。这会让我省得更多。

【讨论】：

我还没有编写一个宏代码来执行此操作：ni.com/example/27269/en 在 2D 数组中搜索多个匹配项此示例说明如何在 2D 数组中搜索指定值。 VI 使用 For 循环遍历 2D 数组的每个元素。每当 LabVIEW 找到一个等于搜索值的元素时，LabVIEW 会将元素的索引添加到一个单独的数组中，然后将这些索引存储在一个移位寄存器中以供循环的剩余迭代使用。该 VI 查找数组中与搜索值匹配的每个元素。

以上是关于返回数组Excel VBA中元素的索引的主要内容，如果未能解决你的问题，请参考以下文章

excel vba函数返回数组并粘贴到工作表公式中

Excel VBA：将变体数组返回到选定范围时需要 255 转置字符限制的解决方法

filter 对已知数组进行筛选，返回为true的元素或对象并组成一个新数组

如何将 Excel 数组公式传递给 VBA UDF？

excel vba索引匹配数组以分隔文件

VB 数组中如何根据值返回元素的位置索引值