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 进行查找替换，但替换部分将是计算出的查找硬编码。

IE

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