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