VBA搜索范围内单元格中的VLOOKUP并计算_Vba_Excel

VBA搜索范围内单元格中的VLOOKUP并计算

vba excel

VBA搜索范围内单元格中的VLOOKUP并计算,vba,excel,Vba,Excel,如果你想在单元格中循环并查找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

如果你想在单元格中循环并查找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上的替换，但替换部分将是硬编码的计算查找

即

如何完成这个

为了做到这一点，您需要（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

为此，您需要（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

这将涵盖公式中的多个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

Sub-tgr（）
将ws设置为工作表
暗光范围
第一个作为字符串
以字符串形式显示秒
作为字符串的Dim sTemp
以字符串形式查找
作为字符串的Dim sValue
暗坡坡坡长
Dim LCLOSSPARENCOUNT尽可能长
我想我会坚持多久
设置ws=ActiveWorkbook.ActiveSheet
使用ws.UsedRange
Set rFound=.Find（“VLOOKUP”，.Cells（.Cells.Count），xlFormulas，xlPart）
如果没有找到，那就什么都不是了
sFirst=rFound.Address
做
如果左（rFound.Formula，1）=“=”则
安装时执行（1，rFound.公式，“VLOOKUP”，vbTextCompare）>0
sVLOOKUP=vbNullString
sValue=vbNullString
对于i=InStr（1，rFound.Formula，“VLOOKUP”，vbTextCompare）到Len（rFound.Formula）
sTemp=Mid（rFound.Formula，i，1）
sVLOOKUP=sVLOOKUP&sTemp
选择案例sTemp
大小写“（”：lOpenParenCount=lOpenParenCount+1
案例“）”：lCloseParenCount=lCloseParenCount+1
如果lCloseParenCount=lOpenParenCount，则退出
结束选择
接下来我
出错时继续下一步
sValue=评估（sVLOOKUP）
错误转到0
如果Len（sValue）=0，则sValue=“#N/A”
rFound.Formula=Replace（rFound.Formula，sVLOOKUP，svvalue）
环
其他的
如果Len（sSecond）=0，则sSecond=rFound.Address
如果结束
设置rFound=.FindNext（rFound）
如果rFound为Nothing，则退出Do
在rFound.Address sFirst和rFound.Address sSecond时循环
如果结束
以
端接头

这将涵盖公式中的多个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

Sub-tgr（）
将ws设置为工作表
暗光范围
第一个作为字符串
以字符串形式显示秒
作为字符串的Dim sTemp
以字符串形式查找
作为字符串的Dim sValue
暗坡坡坡长
Dim LCLOSSPARENCOUNT尽可能长
我想我会坚持多久
设置ws=ActiveWorkbook.ActiveSheet
使用ws.UsedRange
Set rFound=.Find（“VLOOKUP”，.Cells（.Cells.Count），xlFormulas，xlPart）
如果没有找到，那就什么都不是了
sFirst=rFound.Address
做
如果左（rFound.Formula，1）=“=”则
安装时执行（1，rFound.公式，“VLOOKUP”，vbTextCompare）>0
sVLOOKUP=vbNullString
sValue=vbNullString
对于i=InStr（1，rFound.Formula，“VLOOKUP”，vbTextCompare）到Len（rFound.Formula）
sTemp=Mid（rFound.Formula，i，1）
sVLOOKUP=sVLOOKUP&sTemp
选择案例sTemp
大小写“（”：lOpenParenCount=lOpenParenCount+1
案例“）”：lCloseParenCount=lCloseParenCount+1
如果lCloseParenCount=lOpenParenCount，则退出
结束选择
接下来我
出错时继续下一步
sValue=评估（sVLOOKUP）
错误转到0
如果Len（sValue）=0，则sValue=“#N/A”
rFound.Formula=Replace（rFound.Formula，sVLOOKUP，svvalue）
环
其他的
如果Len（sSecond）=0，则sSecond=rFound.Address
如果结束
设置rFound=.FindNext（rFound）
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