VBA在范围内的单元格中searchVLOOKUP并计算
如果想循环遍历单元格并查找一个查找公式，并计算一个可能的操作如下：
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在其他计算之间，那么人们希望能够在所需的范围内findVLOOKUP的replace，但replace部分将是硬编码的计算查找。
即
H4 + A10*VLOOKUP("This",A:1:B3,2,0)*A1/B2+C3 = H4 + A10*"lookupvalue"*A1/B2+C3
怎么会去完成这个
这将涵盖公式中的多个vlookup，并将覆盖vlookup中的embedded式公式。 如果在评估vlookup时有任何错误，它也将使用＃N / A：
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
为了做到这一点，你需要（1）取公式string; （2）分解与Vlookup相关的部分vs与其他部分相关的部分，将每个部分存储为它自己的stringvariables; （3）在VBA中手动运行Vlookup部分以查找值; （4）将单元格中的公式replace为其后的所有其他值。
因为您的检查公式假定VLOOKUP将在单元格的开头，这使得该过程稍微简单一些，因为我们不需要检查VLOOKUP之前的“其他部分”。
我build议的代码来执行这些步骤如下[我已经testing并证实这个工程]：
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
我迟到了这个派对，但这是我的解决scheme。 与已经发布的两个版本没有什么不同，但是它的devise思路是使用专门devise的函数来提取函数中LOOKUP的评估值，并在函数中返回已更改的公式。 这样，如果你循环遍历一系列的单元格，你可以select基于特定的标准来调用函数，例如，如果单元格有公式，或者是隐藏的，或者类似的东西。
这个function：
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