Return Index of an Element in an Array Excel VBA

后端 未结 7 1661
悲&欢浪女
悲&欢浪女 2020-11-29 20:42

I have an array prLst that is a list of integers. The integers are not sorted, because their position in the array represents a particular column on a spreadsheet. I want t

7条回答
  •  慢半拍i
    慢半拍i (楼主)
    2020-11-29 20:57

    array of variants:

        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
    

    a fastest version for integers (as pref tested below)

        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)
    

    a snippet, lets test the assumption the passing by reference as argument means something. (the answer is no) to use it replace myList and myValue to your variable names:

      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
    

    to prove the point I have made some benchmarks

    here are the results:

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

    a module:

    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
    

    a class named 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
    

提交回复
热议问题