Улучшите гибкость VBA для преобразования VLOOKUP в INDEX / MATCH

После того, как все мои поиски кода для чтения в формуле 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.

Чтобы избежать всех ошибок, о которых я могу думать, вам нужно будет изменить их на не очень хороший способ:

 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 – это не просто адрес, это не сработает.

Если у вас все еще есть вопросы, просто спросите;)

Interesting Posts

В Windows Excel VBA, как получить ключи JSON для предварительной «ошибки времени выполнения» 438: Объект не поддерживает это свойство или метод »?

Ошибка несоответствия типа Excel 13 в VBA при выборе нескольких ячеек

Как сделать эквивалентную функцию MOD excel в PHP

подсчитывать элементы по разделителю имени uniq по номеру позиции

Сравнение столбца с определенным значением возвращает значение другого столбца в другой столбец

Excel: последнее совпадение символов / строк в строке

Проверьте, существует ли папка и сохраните два листа там VBA Excel

Excel перебирает строки и назначает случайную дату

Улучшение сравнения клеток

Ошибка VLOOKUP с выводом формулы с помощью Right (), Len () и Find ()

Как вызвать функцию на клавише ENTER в Excel с помощью vba

Функция, определяемая пользователем, для ввода целых чисел в качестве входных данных и изменения ее в строку для выполнения результата сравнения индекса и результата

Могу ли я контролировать физические размеры загруженной таблицы Excel?

Выделите все ячейки в столбце B, где столбец A в этой строке кодирует определенный текст

VBA Excel, VLookup для нескольких значений count

Давайте будем гением компьютера.