在我搜索完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组合公式。
答案 0 :(得分：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不仅仅是一个地址，那么这将失败。
如果您还有任何疑问，请询问;）