我有一个数组prLst,它是一个整数列表。整数未排序,因为它们在数组中的位置表示电子表格中的特定列。我想知道如何在数组中找到一个特定的整数,并返回其索引。
似乎没有任何资源可以告诉我如何在不将数组转换为工作表的范围内。这看起来有点复杂。这对VBA来说是不可能的吗?
答案 0 :(得分:70)
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()
对数组进行切片会产生可怕的性能。
在测试中(下面的代码),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 :(得分: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
整数的最快版本(如下面的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
答案 2 :(得分:1)
这是另一种方式:
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
答案 3 :(得分:0)
这是你在找什么?
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
答案 4 :(得分:0)
注意阵列是从零还是一开始。 此外,当函数返回位置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
答案 5 :(得分:0)
'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
答案 6 :(得分:0)
我能做到这一点的唯一方法(尽管很麻烦,但还是很方便/相对较快),是将任意维数组连接起来,并将其缩小为1维,并带有“ / [列号] // \ | ”作为分隔符。
&在此1-d列上使用单单元格结果多个lookupall宏函数。
&然后进行索引匹配以提取位置。 (使用多个查找匹配项)
这样,您就可以在原始的任意维数组中找到所需的所有匹配元素/字符串,以及它们的位置。在一个单元格中。
希望我可以为整个过程编写一个宏/函数。这样可以省去我更多的麻烦。