excel表格，不自动更新结果，需要双击单元格，才更新结果，怎么办？

[jyljb888]

excel单元格不自动刷新结果，需要双击单元格才能更新结果，牵扯到的功能在最下面的一个sub

链接：https://pan.baidu.com/s/1IXOwncMLfNswcnvLSOxGEw
提取码：0ija
复制这段内容后打开百度网盘手机App，操作更方便哦

[code=textOption Explicit

Const kFirstCol As Integer = 1
Const kLastCol As Integer = 4

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error GoTo ErrorHandler
    Dim rng As Range, rngIndex As Range
    Dim i As Long
    
    Set rng = Intersect(Target, Range("I:I"))
    If Not rng Is Nothing Then
        For Each rngIndex In rng
            If rngIndex.formula Like "=SUM*" Then
                rngIndex.Offset(0, 2) = "合计"
                rngIndex.Offset(0, 2).Interior.Color = RGB(255, 255, 0)
            ElseIf Cells(rngIndex.Row, "G") = "" Then
                rngIndex.Offset(0, 2) = ""
                rngIndex.Offset(0, 2).Interior.Pattern = xlNone
            End If
        Next
        
    End If
    Set rng = Nothing
    
    Set rng = Intersect(Target, Range("G:G"))
    If Not rng Is Nothing Then
        For Each rngIndex In rng
            EvalEx rngIndex
            SetOthers rngIndex
        Next
        For Each rngIndex In rng
            If Cells(rngIndex.Row, "L") <> "" Then
                For i = 3 To Range("g" & Rows.Count).End(xlUp).Row
                    If Cells(i, "G") Like "*" & Cells(rngIndex.Row, "L") & "*" Then
                        EvalEx Cells(i, "G")
                        SetOthers Cells(i, "G")
                    End If
                Next
            End If
        Next
    End If
    Set rng = Nothing
    
    Set rng = Intersect(Target, Range("E:F"))
    If Not rng Is Nothing Then
        For Each rngIndex In rng
            SetOthers rngIndex
        Next
        For Each rngIndex In rng
            If Cells(rngIndex.Row, "L") <> "" Then
                For i = 3 To Range("g" & Rows.Count).End(xlUp).Row
                    If Cells(i, "G") Like "*" & Cells(rngIndex.Row, "L") & "*" Then
                        EvalEx Cells(i, "G")
                        SetOthers Cells(i, "G")
                    End If
                Next
            End If
        Next
    End If
    Set rng = Nothing
    
    

ErrorHandler:
End Sub

Sub SetOthers(rng As Range)
    Dim thisRow As Long
    Dim rngE As Range, rngF As Range, rngH As Range, rngI As Range
    
    ' 1、如果H3为空，则I3也为空
    thisRow = rng.Row
    If IsError(Range("H" & thisRow).Value) Then
        Range("H" & thisRow).Value = ""
        GoTo SubEnd
    End If
    
    If Range("H" & thisRow).Value = "" Then
        Range("I" & thisRow).Value = ""
        GoTo SubEnd
    End If
    
    Set rngE = Range("E" & thisRow)
    Set rngF = Range("F" & thisRow)
    Set rngH = Range("H" & thisRow)
    Set rngI = Range("I" & thisRow)
    
    ' 2、如果E3为空，F3为空，则I3=H3
    ' 3、如果E3不为空，F3为空，则I3=E3*H3
    ' 4、如果E3为空，F3不为空，则I3=F3*H3
    ' 5、如果E3不为空，F3不为空，则I3=E3*F3*H3
    If rngE.Value = "" And rngF.Value = "" Then
        rngI.Value = rngH.Value
    ElseIf rngE.Value <> "" And rngF.Value = "" Then
        rngI.Value = rngE.Value * rngH.Value
    ElseIf rngE.Value = "" And rngF.Value <> "" Then
        rngI.Value = rngF.Value * rngH.Value
    Else
        rngI.Value = rngE.Value * rngF.Value * rngH.Value
    End If
    
    Set rngE = Nothing
    Set rngF = Nothing
    Set rngH = Nothing
    Set rngI = Nothing
    
SubEnd:
End Sub

Sub EvalEx(rng As Range)
    Dim formula As String
    Dim arr As Variant
    Dim i As Long
    
    ' On Error GoTo ErrorHandler
    formula = rng.Value
    If Trim(formula) = "" Then
        rng.Offset(0, 1).Value = ""
        Exit Sub
    End If
    
    ' 替换中文符号为英文符号
    formula = Replace(formula, "｛", "{")
    formula = Replace(formula, "｝", "}")
    formula = Replace(formula, "（", "(")
    formula = Replace(formula, "）", ")")
    formula = Replace(formula, "／", "/")
    
    ' 用正则把{*}所有字符替换为空（其实不用正则用查找替换功能也行）
    With CreateObject("vbscript.regexp")
        .Pattern = "\{([^\{]+)\}"
        .Global = True
        formula = .Replace(formula, "")
    End With
    ' 用正则把
所有字符替换为空
      With CreateObject
("vbscript.regexp")
        .Pattern = "\[([^\[]+)\]"
        .Global = True
        formula = .Replace(formula, "")
    End With


    ' 变量改成实际数值，必须从最长字符串开始替换
    'arr = Range(Range("J2"), Range("K" & Range("K" & Rows.Count).End(xlUp).Row))
    arr = Range(Range("I3"), Range("L" & Range("L" & Rows.Count).End(xlUp).Row))
    SortArray arr
    For i = LBound(arr) To UBound(arr)
        'If arr(i, kLastCol) = "" Then Exit For
        formula = Replace(formula, arr(i, kLastCol), arr(i, kFirstCol))
    Next i
    
    ' 计算结果并写入对应的单元格
    rng.Offset(0, 1).Value = Evaluate(formula)
    
    
    
ErrorHandler:
End Sub

Sub SortArray(arr As Variant)
    Dim i As Long, j As Long
    Dim temp As Variant
    Dim hasExchanged As Boolean
    
    
    
    For i = LBound(arr) To UBound(arr) - 1
        hasExchanged = False
        For j = i + 1 To UBound(arr)
            If Len(arr(i, kLastCol)) < Len(arr(j, kLastCol)) Then
                ' 交换变量名对应的数值
                temp = arr(i, 1)
                arr(i, 1) = arr(j, 1)
                arr(j, 1) = temp
                
                ' 交换变量名
                temp = arr(i, kLastCol)
                arr(i, kLastCol) = arr(j, kLastCol)
                arr(j, kLastCol) = temp
                
                hasExchanged = True
            End If
        Next j
        If Not hasExchanged Then Exit For
    Next i
End Sub
]

[milaoshu1020]

"如左边所示，代号列会自动引用对应的I列的结果，如果I列的结果是求和而来的，A+B不会自动更新结果，需要双击A+B所在单元格才行，如何修改代码，这个功能的代码在VBA最下面"

"代号列会自动引用对应的I列的结果",你说的代号列是哪一列?
"A+B不会自动更新结果",你说的结果在哪儿?

[milaoshu1020]

参考这个帖子:
https://bbs.csdn.net/topics/392371794
中的问题和13楼的回答;

[vansoft]

既然都写代码了，直接给单元格赋值好了。