數組Excel中的元素的返回索引VBA

Question

我有一個數組prLst，它是一個整數列表。整數沒有排序，因爲它們在數組中的位置表示電子表格上的特定列。我想知道如何在數組中找到一個特定的整數，並返回它的索引。

似乎沒有任何資源向我展示如何將數組轉換爲工作表上的範圍。這似乎有點複雜。這對於VBA來說是不可能的嗎？

Answer 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 

更新使用匹配（帶的.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()來切片數組會有可怕的表現。

在測試中（下面的代碼）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 

Answer 2

這是你在找什麼？

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 

Answer 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 

Answer 4

陣列的變體：

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 

一個最快的版本爲整數（如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) 

---

一個片段，讓我們測試一下這個假設，即通過引用傳遞參數意味着什麼。 （答案是否定的），用它代替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 

Answer 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