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

然而，如果有一个vlookups嵌套在其他计算之间，那么人们希望能够在所需范围内的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相关的部分与与其他所有相关的部分[s]分开，将每个部分存储为自己的字符串变量; （3）手动运行Vlookup部分＆＃39;在VBA中找到价值; （4）用vlookup值替换单元格中的公式，然后是其他所有内容。

因为您的检查公式假定VLOOKUP将位于单元格的开头，这使得该过程稍微简单一些，因为我们不需要检查其他部分＆＃39;在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

VBA在范围和计算单元格中搜索VLOOKUP

3 个答案: