VLOOKUP()使用数组的替代方法

问题描述

我一直在尝试使用数组来查找VLOOKUP()的更快替代方法，这可能需要很长时间才能执行非常大的数据集.

I’ve been experimenting with arrays to find a faster alternative to VLOOKUP(), which can take a long time to execute with very large data sets.

我搜索了SO和许多其他站点，获取了代码片段.

I searched SO and many other sites, grabbing snippets of code.

数据:

• A1:A5要查找的值的列表(1,2,3,4,5)
• C1:C5查找"值(2,4,6,8,10)的范围
• D1:D5值范围为返回"(a，b，c，d，e)

B1:B5是我要粘贴查找到的"值的地方.

B1:B5 is where I’d like to paste the ‘looked-up’ values.

该代码工作到一定程度，因为它确实返回了C1:C5中查找"值的位置的正确值–以及D1中相邻单元格的正确值:D5.

The code works up to a point, in that it does return correct values for the ‘looked-up’ value’s position in C1:C5 – and the correct values in the adjacent cells in D1:D5.

当我尝试将返回值加载到 Arr4 (要粘贴回到工作表的数组)时，当我将鼠标悬停在将鼠标悬停在它上面.它不会阻止代码执行，但不会粘贴任何内容.

When I try to load the returned values to Arr4 (the array to be pasted back to the sheet) which is saying <Type mismatch> when I hover the mouse over it. It doesn’t stop the code from executing, but it doesn’t paste anything.

我的问题是:

1. 如何使用 myVal2 值填充数组 Arr4 ，并且
2. 如何将其粘贴回工作表上?

Option Explicit
Sub testArray()
    Dim ArrLookupValues As Variant
    ArrLookupValues = Sheet1.Range("A1:A5")    'The Lookup Values

    Dim ArrLookupRange As Variant
    ArrLookupRange = Sheet1.Range("C1:C5")    'The Range to find the Value

    Dim ArrReturnValues As Variant
    ArrReturnValues = Sheet1.Range("D1:D5")    'The adjacent Range to return the Lookup Value

    Dim ArrOutput As Variant 'output array

    Dim UpperElement As Long
    UpperElement = UBound(ArrLookupValues)     'Used purely for the ReDim statement

    Dim i As Long
    For i = LBound(ArrLookupValues) To UBound(ArrLookupValues)
        Dim myVal As Variant
        myVal = ArrLookupValues(i, 1)

        Dim pos As Variant 'variant becaus it can return an error
        pos = Application.Match(myVal, ArrLookupRange, 0) 'pos always returns the correct position

        Dim myVal2 As Variant
        If Not IsError(pos) Then
            myVal2 = ArrReturnValues(pos, 1)           'myVal2 always returns the correct value
            ReDim Preserve ArrOutput(1 To UpperElement, 1 To 1)
            ArrOutput(i, 1) = myVal2
        Else
            ReDim Preserve ArrOutput(1 To UpperElement, 1 To 1)
            myVal2 = "Not Found"
            ArrOutput(i, 1) = myVal2
        End If
    Next i

    Dim Destination As Range
    Set Destination = Range("B1")
    Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value =

    ArrOutput
End Sub

推荐答案

• 使用正确的错误处理和 If 语句代替 On Error Resume Next .

  同样，您的 Arr4 必须像其他数组一样是二维的.即使只有一列，也不需要 Arr4(1 to UpperElement，1 To 1)和 Arr4(i，1)= myVal2 .即使只有一列，范围也是总是二维(行，列).

  Also your Arr4 needs to be 2 dimensional like your other arrays. Even if it is only one column it needs no be Arr4(1 To UpperElement, 1 To 1) and Arr4(i, 1) = myVal2. Ranges are always 2 dimensional (row, column) even if there is only one column.

  我强烈建议重命名您的数组变量.每当您感觉必须给变量号时，都可以确定自己做错了.

  And I highly recommend to rename your array variables. When ever you feel like you have to give your variable numbers, you can be sure you are doing it wrong.

  重命名它们，如下所示:

  Rename them like following for example:

  • Arr1 -› ArrLookupValues
  • Arr2 -› ArrLookupRange
  • Arr3 -› ArrReturnValues
  • Arr4 -› ArrOutput
  • Arr1 --› ArrLookupValues
  • Arr2 --› ArrLookupRange
  • Arr3 --› ArrReturnValues
  • Arr4 --› ArrOutput

  这只是一个简单的修改，但是您的代码将大大提高人类的可读性和可维护性.您甚至不需要注释来描述数组，因为它们的名称现在具有自我描述性.

  This is only a simple modification but your code will extremely gain in human readability and maintainability. You even don't need comments to describe the arrays because their names are self descriptive now.

  最后，可以将输出数组声明为与输入数组相同的大小.使用 ReDim Preserve 会使您的代码变慢，因此请避免使用它.

  Finally your output array can be declared the same size as the input arrays. Using ReDim Preserve makes your code slow, so avoid using it.

  所以这样的事情应该起作用:

  So something like this should work:

  Option Explicit
  
  Public Sub testArray()
      Dim ArrLookupValues() As Variant
      ArrLookupValues = Sheet1.Range("A1:A5").Value
  
      Dim ArrLookupRange() As Variant
      ArrLookupRange = Sheet1.Range("C1:C5").Value
  
      Dim ArrReturnValues() As Variant
      ArrReturnValues = Sheet1.Range("D1:D5").Value
  
      Dim UpperElement As Long
      UpperElement = UBound(ArrLookupValues, 1)
  
      'create an empty array (same row count as ArrLookupValues)
      ReDim ArrOutput(1 To UpperElement, 1 To 1)
  
      Dim i As Long
      For i = LBound(ArrLookupValues, 1) To UBound(ArrLookupValues, 1)
          Dim FoundAt As Variant 'variant because it can return an error
          FoundAt = Application.Match(ArrLookupValues(i, 1), ArrLookupRange, 0) 'pos always returns the correct position
  
          If Not IsError(FoundAt) Then
              ArrOutput(i, 1) = ArrReturnValues(FoundAt, 1)
          Else
              ArrOutput(i, 1) = "Not Found"
          End If
      Next i
  
      Dim Destination As Range
      Set Destination = Range("B1") 'make sure to specify a sheet for that range!
      Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = ArrOutput
  End Sub
  

  这篇关于VLOOKUP()使用数组的替代方法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！