提高VBA灵活性，将VLOOKUP转换为INDEX / MATCH
毕竟我search代码来读取一个VLOOKUP公式，并将其转换为INDEX / MATCH空来了，我写了一些自己。
然而，下面的代码缺乏一些我想要的灵活性，但我似乎无法弄清楚如何使其工作。 具体来说，我想testingVLOOKUP公式中的每个范围标准是否为绝对引用，即以$开头，并将其传递给INDEX / MATCH公式。 例如，公式=VLOOKUP(A2,$A$1:B$11,2,FALSE)应该转换为=INDEX(B$1:B$11,MATCH(A2,$A1:$A11,0)) 。
注意：这个子依赖于两个函数（ColumnLetterToNumber和ColumnNumberToLetter）。 正如他们的名字意味着他们采取列字母或数字并相互转换。 这两个function都很简单，而且没有问题。 但是，如果有人认为这些代码对其中的一个或两个都有帮助，我会很乐意提供这些代码。
另外，关于提高代码可读性和/或执行效率的任何想法也将被赞赏。
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组合公式。
为了避免我能想到的所有错误，您需要将其更改为不太好看的方式，如下所示：
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不只是一个地址，这将失败。
如果您还有任何问题，请询问;）