VBA在范圍內的單元格中搜索VLOOKUP並計算

Question

如果要遍歷單元格並查找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

但是，如果在其他計算之間嵌套了vlookup，則將希望能夠在所需范圍內找到VLOOKUP上的替換，但是替換部分將是經過計算的查找硬編碼。

即

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

一個人如何去完成這個

Answer 1

這將覆蓋公式中的多個vlookup，並將覆蓋vlookup中的嵌入式公式。 如果評估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

Answer 2

為此，您將需要（1）采用公式字符串； （2）分解與Vlookup相關的部分與與其他所有部分相關的部分，並將每個部分存儲為自己的字符串變量； （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