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

Return Index of an Element in an Array Excel VBA

提问by H3lue

I have an array prLst that is a list of integers. The integers are not sorted, because their position in the array represents a particular column on a spreadsheet. I want to know how I find a particular integer in the array, and return its index.

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

There does not seem to be any resource on showing me how without turning the array into a range on the worksheet. This seems a bit complicated. Is this just not possible with VBA?

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

回答by Tim Williams

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

Updated to show using Match (with .Index) to find a value in a dimension of a two-dimensional array:

更新以显示使用 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)

---

---

EDIT: it's worth illustrating here what @ARich pointed out in the comments - that using Index()to slice an array has horrible performance if you're doing it in a loop.

编辑：值得在这里说明@ARich 在评论中指出的内容 -Index()如果您在循环中进行切片，则使用切片数组的性能很差。

In testing (code below) the Index() approach is almost 2000-fold slower than using a nested loop.

在测试（下面的代码）中，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

回答by Shimon Doodkin

array of variants:

变体数组：

    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

a fastest version for integers (as pref tested below)

整数的最快版本（如下面的 pref 测试）

    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)

---

---

a snippet, lets test the assumption the passing by reference as argument means something. (the answer is no) to use it replace myList and myValue to your variable names:

一个片段，让我们测试通过引用作为参数传递的假设意味着什么。（答案是否定的）使用它将 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

to prove the point I have made some benchmarks

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

here are the results:

结果如下：

---------------------------
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   
---------------------------

a module:

一个模块：

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

a class named PerformanceMonitor

一个名为 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

回答by Paul McLain

Here's another way:

这是另一种方式：

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

回答by Jon49

Is this what you are looking for?

这是你想要的？

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

回答by luvlogic

Taking care of whether the array starts at zero or one. Also, when position 0 or 1 is returned by the function, making sure that the same is not confused as True or False returned by the function.

注意数组是从 0 还是从 1 开始。此外，当函数返回位置 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

回答by Guest

'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

回答by David Woolley

The only (& even though cumbersome but yet expedient / relatively quick) way I can do this, is to concatenate the any-dimensional array, and reduce it to 1 dimension, with "/[column number]//\|" as the delimiter.

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

& use a single-cell result multiple lookupall macro function on the this 1-d column.

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

& then index match to pull out the positions. (usuing multiple find match)

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

That way you get all matching occurrences of the element/string your looking for, in the original any-dimension array, and their positions. In one cell.

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

Wish I could write a macro / function for this entire process. It would save me more fuss.

希望我可以为整个过程编写一个宏/函数。这样可以省去我更多的麻烦。