提高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)) 。

注意：此子取決於兩個函數（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) ，這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不只是一個地址，那么它將失敗。

如果您還有任何疑問，請問;）