Índice de devolución de un elemento en una matriz 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 la matriz en un rango en la hoja de trabajo. Esto parece un poco complicado. ¿Esto simplemente no es posible con 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 

actualiza para mostrar el uso del partido (con .index) para encontrar un valor en una dimensión de una matriz de dos dimensiones:

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: vale la pena que ilustra aquí lo @ARich señalado 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 de í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 

Answer 2

¿Esto es 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 3

Aquí hay otra manera:

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

matriz 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 los números enteros (como pref probó 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) 

---

snippet, vamos a probar la suposición de que pasar por referencia como argumento significa algo. (La respuesta es no) a usarlo reemplazar miLista y myValue a sus nombres de 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 

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

El cuidado de si la matriz comienza en cero o en 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