2016-05-31 3 views
0

VLOOKUPの式を読み込み、INDEX/MATCHに変換するコードを空にしてしまったので、自分で書きました。VLOOKUPをINDEX/MATCHに変換するためのVBAの柔軟性を向上

しかし、コードには柔軟性がありませんが、動作させる方法を理解できないようです。具体的には、VLOOKUP式の各範囲基準を、絶対参照であるかどうか、つまり$で始まるものとしてテストし、その結果得られるINDEX/MATCH式にその範囲を持ち込んでいきたいと考えています。たとえば、式=VLOOKUP(A2,$A$1:B$11,2,FALSE)=INDEX(B$1:B$11,MATCH(A2,$A1:$A11,0))に変換する必要があります。

注:このサブは、2つの関数(ColumnLetterToNumberおよびColumnNumberToLetter)によって異なります。彼らの名前が意味するように、彼らは列の文字または数字を取り、それらを相互変換する。これらの機能はどちらも短く、シンプルで、問題なく動作します。しかし、どちらか一方または両方のコードが有用であると誰もが信じている場合は、それらを提供することができます。

さらに、コードの可読性および/または実行効率を向上させるためのアイデアも高く評価されます。私はVLOOKUP/HLOOKUPまたはVLOOKUP/MATCHの組み合わせ式を処理することを可能にする次のステップにこれを取るために助けを捜しているわけではない。この時

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 

+0

まずオフ、ちょうどロジックによって: '= VLOOKUP(A2、$ A $ 1:$ 11,2、FALSE)は、' '= INDEXに変換する必要がありますBでは、 ($ B $ 1:B $ 11、MATCH(A2、$ A $ 1:A $ 11,0)) '!範囲は、開始点と終了点の列では絶対的ですが、これは結果にも当てはまります。これはあなたのケースではそれほど問題ではありませんが、より複雑な数式を使用して大きな問題を抱えています。しかし、まだ、あなたのサブを読まずに私は自分自身で書くようにしようとします(それは厄介なので、私と私はそのような仕事が好きです);) –

+0

私はかなり理解していません。まず、あなたのコードで '$'をすべて削除しています。だから、なぜあなたは最初にそれらを排除するのですか?ところで、あなたは既存の 'VLookUp'式を使って上記のコードを解析し、その断片に分解しようとしているようです。しかし、この方法は '= VLOOKUP(IF(G4 = 0,1,2)、A1:B10,1,1)'などの複合式の可能性を克服していないようです。 – Ralph

+0

@DirkReichel私が与えた変換例の鍵は、VLOOKUPでは、Bの前に$がないことです(その範囲を拡大できるようにしています)。もちろん、VLOOKUPは数式をドラッグするのには役立ちません。同僚は範囲を拡大するための準備としてVLOOKUPSをセットアップしました。 –

答えて

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) 

EDIT

にこの方法をされている(めちゃくちゃ) "正常な" あなたは置き換えることができます最後の部分は:

 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が単なるアドレスではない場合、これは失敗します。

あなたはまだちょうど尋ねる、質問があれば;)

+0

私は恩を受けていません。それを実装するチャンス。また、VLOOKUP関数の複雑すぎるバージョンに対処するための関数を探していないと明示的に述べたことを考慮すると、私が探していたよりもはるかに複雑です。私はDirk Reichelが提供した答えをアップアップしましたが、私は十分な評判を持っていないので、アップヴォートを表示しません。私は誰かが私が実際に尋ねた質問に一層緊密に答える簡単な答えを提供できるという希望を抱いていました。 –

+0

議論する理由はありません。投票と承認はちょっとした点です...私はそれらについて気にしません。また、誰もが1つの問題で24時間365日働いているわけではありません。 OPに質問がある場合、彼は聞くことができます。それに時間がかかる場合は、問題ありません。私の答えはもう少し一般的でしたが、今はすべてのテストに成功していますが、それはOPが求めているものではありません...私はもう少しよく質問に一致するものを提供するためにこれを再度調べます。 ) –

+0

@PaaquaGrant私はあなたが望むものに近づくために私の答えを編集しました。あなたの例は '= INDEX(B $ 1:B $ 11、MATCH(A2、$ A $ 1:$ A $ 11,0))'に変更されます。唯一の違いは、 'MATCH'の行は絶対的ですが、私の目にはまた意味があることです。 –

関連する問題