数组Excel VBA中元素的返回索引
我有一个数组prLst是一个整数列表。 整数不sorting，因为它们在数组中的位置表示电子表格上的特定列。 我想知道如何在数组中find一个特定的整数，并返回它的索引。
似乎没有任何资源显示如何将数组转换为工作表上的范围。 这似乎有点复杂。 VBA这只是不可能的吗？
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在评论中指出了什么 – 如果你在一个循环中使用Index()切片数组有一个可怕的performance。
在testing中（下面的代码），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
变体数组：
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
整数最快的版本（如下面的preftesting）
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)
一个片段，让我们testing的假设通过引用作为参数意味着什么。 （答案是否定的）使用它将myList和myValuereplace为您的variables名称：
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
来certificate我做了一些基准的观点
这里是结果：
--------------------------- 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
这是另一种方式：
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
这是你想要的？
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
注意arrays是从零开始还是从零开始。 另外，当函数返回位置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
