arrays - for - vba excel array index

Índice de devolución de un elemento en un arreglo Excel VBA

Question

Tengo una matriz prLst que es una lista de enteros. Los enteros no están ordenados, porque su posición en la matriz representa una columna particular en una hoja de cálculo. Quiero saber cómo encuentro un entero particular en la matriz y devolver su índice.

No parece haber ningún recurso para mostrarme cómo sin convertir el conjunto en un rango en la hoja de trabajo. Esto parece un poco complicado. ¿Esto simplemente no es posible con VBA?

Answer 1

¿Es esto lo que estás buscando?

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 2

Aquí hay otra forma:

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 3

Cuidando si la matriz comienza en cero o uno. Además, cuando la función devuelve la posición 0 o 1, asegúrese de que la función no confunda la misma con True o 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

Answer 4

conjunto de variantes:

 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

una versión más rápida para enteros (como pref probado a continuación)

 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)

un fragmento, permite probar la suposición de que pasar por referencia como argumento significa algo. (la respuesta es no) para usarlo, reemplace myList y myValue por sus nombres de variable:

 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

para probar el punto que he hecho algunos puntos de referencia

aquí están los resultados:

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

un módulo:

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

una clase llamada 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

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

Answer 6

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

Se actualizó para mostrar usando Match (con .Index) para encontrar un valor en una dimensión de una matriz bidimensional:

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)

EDITAR: vale la pena ilustrar aquí lo que @ARich señaló en los comentarios: que usar Index() para cortar una matriz tiene un rendimiento horrible si lo haces en un bucle.

En las pruebas (código a continuación), el enfoque del índice () es casi 2000 veces más lento que el uso de un bucle anidado.

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