redim index for example array arrays excel vba indexing find

arrays - for - vba excel array index



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

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?


¿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


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


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


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


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


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