提高 VBA 将 VLOOKUP 转换为 INDEX/MATCH 的灵活性

Question

在我搜索要在 VLOOKUP 公式中读取的代码并将其转换为 INDEX/MATCH 的所有搜索结果都为空之后，我自己写了一些。

但是，代码（如下）缺乏我想要的一些灵活性，但我似乎无法弄清楚如何使其工作。具体来说，我想测试 VLOOKUP 公式中的每个范围标准是否是绝对参考，即前面有 $，并将其传递给结果的 INDEX/MATCH 公式。例如，公式=VLOOKUP(A2,$A$1:B$11,2,FALSE) 应转换为=INDEX(B$1:B$11,MATCH(A2,$A1:$A11,0))。

注意：这个 sub 依赖于两个函数（ColumnLetterToNumber 和 ColumnNumberToLetter）。正如它们的名字所暗示的那样，它们采用列字母或数字并将它们相互转换。这两个功能都很短、简单，而且工作起来没有问题。但是，如果有人认为对其中一个或两个的代码有帮助，我很乐意提供。

此外，任何关于提高代码可读性和/或执行效率的想法也将不胜感激。

Option Explicit

Public Sub ConvertToIndex()

Dim booLookupType As Boolean
Dim booLeftOfColon As Boolean
Dim booHasRowRef As Boolean
Dim lngStartCol As Long
Dim lngRefCol As Long
Dim lngStart As Long
Dim lngEnd As Long
Dim lngMatchType As Long
Dim lngInt As Long
Dim lngRowRef As Long
Dim strRefCol As String
Dim strOldFormula As String
Dim strNewFormula As String
Dim strLookupCell As String
Dim strValueCol As String
Dim strMatchCol As String
Dim strStartRow As String
Dim strEndRow As String
Dim strCheck As String
Dim strLookupRange As String
Dim strTabRef As String
Dim strSheetRef As String
Dim rngToMod As Range
Dim rngModCell As Range

Set rngToMod = Selection

For Each rngModCell In rngToMod
    strOldFormula = rngModCell.Formula
    lngStart = InStrRev(strOldFormula, "VLOOKUP(")
    If lngStart > 0 Then
        lngStart = InStr(lngStart, strOldFormula, "(") + 1
        lngEnd = InStr(lngStart, strOldFormula, ",")
        strLookupCell = Mid(strOldFormula, lngStart, lngEnd - lngStart)
        lngStart = lngEnd + 1
        lngEnd = InStr(lngStart, strOldFormula, ",")
        strLookupRange = Mid(strOldFormula, lngStart, lngEnd - lngStart)
        lngStart = lngEnd + 1
        lngEnd = InStr(lngStart, strOldFormula, ",")
        lngRefCol = CInt(Mid(strOldFormula, lngStart, lngEnd - lngStart))
        lngStart = lngEnd + 1
        lngEnd = InStr(lngStart, strOldFormula, ")")
        booLookupType = (Mid(strOldFormula, lngStart, lngEnd - lngStart) = "TRUE")
        If booLookupType Then
            lngMatchType = 1
        Else
            lngMatchType = 0
        End If
        booLeftOfColon = True
        lngEnd = InStr(1, strLookupRange, "]")
        If lngEnd > 0 Then
            strSheetRef = Left(strLookupRange, lngEnd)
            strLookupRange = Right(strLookupRange, Len(strLookupRange) - lngEnd)
        Else
            strSheetRef = ""
        End If
        lngEnd = InStr(1, strLookupRange, "!")
        If lngEnd > 0 Then
            strTabRef = Left(strLookupRange, lngEnd)
            strLookupRange = Right(strLookupRange, Len(strLookupRange) - lngEnd)
        Else
            strTabRef = ""
        End If
        For lngInt = 1 To Len(strLookupRange)
            strCheck = Mid(strLookupRange, lngInt, 1)
            Select Case True
                Case strCheck = ":"
                    booLeftOfColon = False
                Case booLeftOfColon
                    If IsNumeric(strCheck) Then
                        strStartRow = strStartRow & strCheck
                    Else
                        strMatchCol = strMatchCol & strCheck
                    End If
                Case Else
                    If IsNumeric(strCheck) Then strEndRow = strEndRow & strCheck
            End Select
        Next lngInt
        strMatchCol = Replace(strMatchCol, "$", "")
        lngStartCol = ColumnLetterToNumber(strMatchCol)
        strValueCol = ColumnNumberToLetter(lngStartCol + lngRefCol - 1)
        If Len(strStartRow) > 0 Then strStartRow = "$" & strStartRow
        If Len(strEndRow) > 0 Then strEndRow = "$" & strEndRow
        strValueCol = strSheetRef & strTabRef & strValueCol & strStartRow & ":" & strValueCol & strEndRow
        strMatchCol = strSheetRef & strTabRef & strMatchCol & strStartRow & ":" & strMatchCol & strEndRow
        strNewFormula = "=INDEX(" & strValueCol & ",MATCH(" & "$" & strLookupCell & "," & strMatchCol & "," & lngMatchType & "))"
        rngModCell.Formula = strNewFormula
    End If
Next rngModCell

End Sub

目前，我不寻求帮助以使其能够处理 VLOOKUP/HLOOKUP 或 VLOOKUP/MATCH 组合公式的下一步。

Answer 1

为避免我能想到的所有错误，您需要将其更改为不太好看的方式，如下所示：

Sub changeToIndex()

  Dim xText As Boolean
  Dim xBrac As Long
  Dim VLSep As New Collection
  Dim i As Long, t As String

  With Selection.Cells(1, 1) 'just for now

    'it assumes that there is NEVER a text string which has VLOOKUP like =A1&"mean text with VLOOKUP inside it"
    While InStr(1, .Formula, "VLOOKUP", vbTextCompare)

      Set VLSep = New Collection
      VLSep.Add " " & InStr(1, .Formula, "VLOOKUP", vbTextCompare) + 7

      'get the parts
      For i = VLSep(1) + 1 To Len(.Formula)
        t = Mid(.Formula, i, 1)
        If t = """" Then
          xText = Not xText
        ElseIf Not xText Then 'avoid "(", ")" and "," inside of the string to be count

          If t = "(" Then
            xBrac = xBrac + 1
          ElseIf xBrac Then 'cover up if inside of other functions
            If t = ")" Then xBrac = xBrac - 1
          ElseIf t = ")" Then
            VLSep.Add " " & i
            Exit For
          ElseIf t = "," Then
            VLSep.Add " " & i 'the space is to avoid errors with index and item if both are numbers
          End If

        End If
      Next

      Dim xFind As String 'get all the parts
      Dim xRng As String
      Dim xCol As String
      Dim xType As String

      xFind = Mid(.Formula, VLSep(1) + 1, VLSep(2) - VLSep(1) - 1)
      xRng = Mid(.Formula, VLSep(2) + 1, VLSep(3) - VLSep(2) - 1)
      xCol = Mid(.Formula, VLSep(3) + 1, VLSep(4) - VLSep(3) - 1)
      If VLSep.Count = 5 Then
        xType = Mid(.Formula, VLSep(4) + 1, VLSep(5) - VLSep(4) - 1)
      Else
        xType = "0"
      End If

      Dim fullFormulaNew As String 'get the whole formulas
      Dim fullFormulaOld As String

      fullFormulaNew = "INDEX(" & xRng & ",MATCH(" & xFind & ",INDEX(" & xRng & ",,1)," & xType & ")," & xCol & ")"
      fullFormulaOld = Mid(Selection.Cells(1, 1).Formula, VLSep(1) - 7, VLSep(VLSep.Count) - VLSep(1) + 8)

      .Formula = Replace(.Formula, fullFormulaOld, fullFormulaNew) 'simply replace the old one with the new one
    Wend

  End With
End Sub

它也适用于非常复杂的公式。你仍然需要一些特殊的检查来削减一切，让它看起来像你想要的。我只是假设 vlookup 的范围可能类似于IF(A1=1,B1:C10,L5:N30) 这就是说，您需要额外的潜艇来清除类似的东西。 :(

类似的公式

=VLOOKUP(VLOOKUP(IF(TRUE,A2,"aaa"),$A$1:B$11,2),$B$1:$C$11,2,FALSE)

会以这种方式改变（搞砸）

=INDEX($B$1:$C$11,MATCH(INDEX($A$1:B$11,MATCH(IF(TRUE,A2,"aaa"),INDEX($A$1:B$11,,1),0),2),INDEX($B$1:$C$11,,1),FALSE),2)

编辑

假设您的公式是“正常的”，您可以将最后一部分替换为：

      Dim xFind As String 'get all the parts
      Dim xRngI As String, xRngM As String
      Dim xCol As String
      Dim xType As String

      xFind = Mid(.Formula, VLSep(1) + 1, VLSep(2) - VLSep(1) - 1)
      xRngI = Mid(.Formula, VLSep(2) + 1, VLSep(3) - VLSep(2) - 1)
      xCol = Mid(.Formula, VLSep(3) + 1, VLSep(4) - VLSep(3) - 1)
      If VLSep.Count = 5 Then
        xType = Mid(.Formula, VLSep(4) + 1, VLSep(5) - VLSep(4) - 1)
      Else
        xType = "0"
      End If
      If xType = "FALSE" Then xType = 0

      Do While Not IsNumeric(xCol)
        Select Case MsgBox("Error: The Column to pick from is not numerical! Do you want to manually set the column (Yes) or directly use the last column of the input range (No)?", vbYesNoCancel)
        Case vbYes
          xCol = Application.InputBox("Input the column number for the input range (" & xRngI & "). '1' will be the range " & Range(xRngI).Columns(1).Address(0, 0) & ".", "Column to pick from", 1, , , , , 2)
        Case vbNo
          xCol = Range(xRngI).Columns.Count
        Case vbCancel
          xCol = " "
          Exit Do
        End Select
        If xCol <> CInt(xCol) Or xCol > Range(xRngI).Columns.Count Or xCol = 0 Then xCol = " "
      Loop

      If IsNumeric(xCol) Then

        Dim absRs As Boolean, absRe As Boolean, absCs As Boolean, absCe As Boolean

        absCs = (Left(xRngI, 1) = "$")
        absCe = (Mid(xRngI, InStr(xRngI, ":") + 1, 1) = "$")
        absRs = (InStr(2, Left(xRngI, InStr(xRngI, ":") - 1), "$") > 0)
        absRe = (InStr(Mid(xRngI, InStr(xRngI, ":") + 2), "$") > 0)

        xRngM = Range(xRngI).Columns(1).Cells(1, 1).Address(absRs, absCs) & ":" & Range(xRngI).Columns(1).Cells(Range(xRngI).Rows.Count, 1).Address(absRe, absCs) 'for MATCH
        xRngI = Range(xRngI).Cells(1, CLng(xCol)).Address(absRs, absCe) & ":" & Range(xRngI).Cells(Range(xRngI).Rows.Count, CLng(xCol)).Address(absRe, absCe) 'for INDEX

        Dim fullFormulaNew As String, fullFormulaOld As String

        fullFormulaNew = "INDEX(" & xRngI & ",MATCH(" & xFind & "," & xRngM & "," & xType & "))"
        fullFormulaOld = Mid(Selection.Cells(1, 1).Formula, VLSep(1) - 7, VLSep(VLSep.Count) - VLSep(1) + 8)

        .Formula = Replace(.Formula, fullFormulaOld, fullFormulaNew) 'simply replace the old one with the new one

      End If

    Wend

  End With
End Sub

如您所见：结果“越简单”，您需要的代码就越多。如果lookup_range 不仅仅是一个地址，这将失败。

如果你还有任何问题，尽管问;)