VBA搜索VLOOKUP在單元格範圍和計算

Question

如果一個人通過細胞和lookinto的VLOOKUP公式要循環，並計算一個如下會這樣做：

Dim r As Range 

For i = 1 To 100 
    With wsSWM.Columns(i).SpecialCells(xlCellTypeFormulas) 
     For Each r In .Cells 
      If Left(r.Formula, 8) = "=VLOOKUP" Then r.Value = r.Value 
     Next r 
    End With 
Next i 

但是，如果一個人依偎在之間vlookups其他計算則需要能夠在期望的範圍內找到VLOOKUP上的替換，但替換部分將是硬編碼的計算查找。

即

H4 + A10*VLOOKUP("This",A:1:B3,2,0)*A1/B2+C3 = H4 + A10*"lookupvalue"*A1/B2+C3 

一個如何去完成這個

Answer 1

這將覆蓋式在多個vlookups，並將涵蓋VLOOKUP內的嵌入公式。它也將只使用＃N/A是否有評估VLOOKUP任何錯誤：

Sub tgr() 

    Dim ws As Worksheet 
    Dim rFound As Range 
    Dim sFirst As String 
    Dim sSecond As String 
    Dim sTemp As String 
    Dim sVLOOKUP As String 
    Dim sValue As String 
    Dim lOpenParenCount As Long 
    Dim lCloseParenCount As Long 
    Dim i As Long 

    Set ws = ActiveWorkbook.ActiveSheet 

    With ws.UsedRange 
     Set rFound = .Find("VLOOKUP", .Cells(.Cells.Count), xlFormulas, xlPart) 
     If Not rFound Is Nothing Then 
      sFirst = rFound.Address 
      Do 
       If Left(rFound.Formula, 1) = "=" Then 
        Do While InStr(1, rFound.Formula, "VLOOKUP", vbTextCompare) > 0 
         sVLOOKUP = vbNullString 
         sValue = vbNullString 
         For i = InStr(1, rFound.Formula, "VLOOKUP", vbTextCompare) To Len(rFound.Formula) 
          sTemp = Mid(rFound.Formula, i, 1) 
          sVLOOKUP = sVLOOKUP & sTemp 
          Select Case sTemp 
           Case "(": lOpenParenCount = lOpenParenCount + 1 
           Case ")": lCloseParenCount = lCloseParenCount + 1 
              If lCloseParenCount = lOpenParenCount Then Exit For 
          End Select 
         Next i 
         On Error Resume Next 
         sValue = Evaluate(sVLOOKUP) 
         On Error GoTo 0 
         If Len(sValue) = 0 Then sValue = "#N/A" 
         rFound.Formula = Replace(rFound.Formula, sVLOOKUP, sValue) 
        Loop 
       Else 
        If Len(sSecond) = 0 Then sSecond = rFound.Address 
       End If 
       Set rFound = .FindNext(rFound) 
       If rFound Is Nothing Then Exit Do 
      Loop While rFound.Address <> sFirst And rFound.Address <> sSecond 
     End If 
    End With 

End Sub 

Answer 2

爲了做到這一點，你將需要：（1）取公式字符串; （2）分解與Vlookup相關的部分vs與其他部分相關的部分，將每個部分存儲爲它自己的字符串變量; （3）在VBA中'手動'運行Vlookup部分以查找值;和（4）用vlookup值替換單元格中的公式，然後是其他所有內容。

由於您的檢查公式假定VLOOKUP將位於單元格的開頭，這使得該過程稍微簡單一些，因爲我們不需要檢查VLOOKUP之前的「其他部分」。

我建議的代碼，以執行這些步驟將如下所示〔Ⅰ已經測試並確認其工作原理]：

Dim r As Range 
Dim lookupString as String 'stores the portion of the formula which represents the Vlookup 
Dim lookupValue as Double 'Stores the value of the lookup 
Dim otherString as String 'stores the rest of the string 
Dim formulaBrackets as Integer 'used to count how many brackets are contained within the Vlookup, to find where it ends 

For i = 1 To 100 
    With wsSWM.Columns(i).SpecialCells(xlCellTypeFormulas) 
     For Each r In .Cells 
      If Left(r.Formula, 8) = "=VLOOKUP" Then 
       formulaBrackets = 0 
       For j = 1 to Len(r.Formula) 
        If Mid(r.Formula,j,1) = "(" Then 
         formulaBrackets = formulaBrackets + 1 
        ElseIf Mid(r.Formula,j,1) = ")" Then 
         formulaBrackets = formulaBrackets - 1 
         If formulaBrackets = 0 Then 
          lookupString = Mid(r.Formula,2,j-1) 'picks up the string starting from the V in Vlookup [excludes the '='], up to the final bracket 
          otherString = Mid(r.Formula,j+1,Len(r.Formula)) 'picks up the string starting AFTER the ending bracket, to the end of thes formula 
          r.Formula = "="&lookupString 'sets up the formula in the cell to calculate the vlookup as written 
          lookupValue = r.value 
          r.Formula = "=" & lookupValue & otherString 'recreates the formula, having replaced the vlookup with its calculated value 
          Exit For 
         End If 
        Else 
         'No action required 
        End If 
       Next j 

      End If 
     Next r 
    End With 
Next i 

Answer 3

我來晚了黨在這一個，但這裏是我的解決方案。它與已經發布的兩個版本沒有太大區別，但是它的確使用了一個專門設計用於提取函數中LOOKUP的評估值的函數，並返回函數中已更改的公式。這樣，如果您循環遍歷一系列單元格，則可以根據特定條件選擇調用函數，例如，如果單元格具有公式，或者隱藏或者類似的話。

這裏的功能：

Function ExtractVLOOKUPValue(rng As Range) As Variant 
' This will extract the returned value of the first instance 
' of a VLOOKUP formula in a cell. 

' Constant declarations. 
Const sVLOOKUP  As String = "VLOOKUP" 
Const lVLOOKUP_LEN As String = 7 
Const sOPEN_PAREN As String = "(" 
Const sCLOSE_PAREN As String = ")" 

' Variable declarations. 
Dim lVlookupPos  As Long 
Dim lCnt   As Long 
Dim lParenCnt  As Long 
Dim sVlookupFormula As String 
Dim sResult   As String 

' Check first if the cell is a formula, and then 
' if a VLOOKUP formula exists in the cell. 
If rng.HasFormula Then 

    lVlookupPos = InStr(rng.Formula, sVLOOKUP) 
    If lVlookupPos <> 0 Then 

     ' Isolate the VLOOKUP formula itself. 
     For lCnt = lVlookupPos To Len(rng.Formula) 

      ' Count the open parentheses we encounter so that we can use 
      ' the apporpriate number of closing parentheses. 
      If Mid(rng.Formula, lCnt, 1) = sOPEN_PAREN Then lParenCnt = lParenCnt + 1 

      ' If we get to closing parenthese, start taking counts away from the 
      ' parencnt variable so we can keep track of the correct number of 
      ' parenthesis in hte formula. 
      If Mid(rng.Formula, lCnt, 1) = sCLOSE_PAREN Then 
       lParenCnt = lParenCnt - 1 

       ' If we get done to zero in the parencnt, then extract the formula. 
       If lParenCnt = 0 Then 
        sVlookupFormula = Mid(rng.Formula, lVlookupPos, lCnt + 1 - lVlookupPos) 
        Exit For 
       End If 

      End If 

     Next lCnt 

    End If 

End If 

' Now that we have the formula, we can evalutate the result. 
On Error Resume Next 
sResult = Evaluate(sVlookupFormula) 

' If we errored out, return the #N/A in the function. 
If Err.Number <> 0 Then 
    sResult = "#N/A" 
End If 

' Replace the VLOOKUP in the formula with the result, then return it to the function. 
sResult = Replace(rng.Formula, sVlookupFormula, sResult) 

' Return the result, having replaced the VLOOKUP function. 
ExtractVLOOKUPValue = sResult 

End Function 

而且這裏是你會如何稱呼它：

Sub ReplaceFormulaWithValue() 
Dim rng As Range 
Dim rCell As Range 

Set rng = Selection 

For Each rCell In rng 
    rCell.Formula = ExtractVLOOKUPValue(rCell) 
Next rCell 

End Sub