You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

请求修改Excel VBA代码:去重后计算T列平均值

修改Excel VBA代码:新增T列平均值计算

原代码功能为检查I列重复项、删除重复项并对R、S、U、V列求和,以下是添加T列平均值计算的修改版本:

Private Sub Worksheet_Change(ByVal Target As Range)
    Const PROC_TITLE As String = "移除重复项"
    ' ActiveWindow.DisplayZeros = False                                             1
    ' 启动错误处理
    
    Dim Success As Boolean
    On Error GoTo ClearError
     
    ' 定义常量
    Const FIRST_CELL As String = "A4"
    Const UNIQUE_COLUMN As Long = 9 ' I列
    Const AVG_COLUMN As Long = 20 ' T列(新增:要计算平均值的列)
    Dim SumupColumns(): SumupColumns = VBA.Array(18, 19, 21, 22) ' R, S, U ,V列
    
    ' 引用工作表
    Dim ws As Worksheet: Set ws = Target.Worksheet
    
    ' 检查是否在唯一列(I列)发生修改
    Dim rg As Range:
    With ws.Range(FIRST_CELL).EntireRow.Columns(UNIQUE_COLUMN)
        Set rg = .Resize(ws.Rows.Count - .Row + 1)
    End With
        
    Dim irg As Range: Set irg = Intersect(rg, Target)
    If irg Is Nothing Then Exit Sub
    
    ' 引用数据源区域
    If ws.FilterMode Then ws.ShowAllData
    
    Dim sUpper As Long: sUpper = UBound(SumupColumns)
    Dim srg As Range
    
    With ws.UsedRange
        Set srg = ws.Range(FIRST_CELL, .Cells(.Cells.CountLarge))
    End With
    ' Columns("A:AE").HorizontalAlignment = xlCenter        居中对齐
     Dim srCount As Long: srCount = srg.Rows.Count
     Dim cCount As Long: cCount = srg.Columns.Count
    
    ' 将数据源区域的值写入数组
    Dim Data(): Data = srg.Value

    ' 用字典存储唯一值对应的行号、T列累计值和出现次数
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim uVal, sr As Long
    Dim avgTotal As Double, count As Long
    
    ' 先遍历到第一个重复项,之前的数据保持不变
    For sr = 1 To srCount
        uVal = Data(sr, UNIQUE_COLUMN)
        If dict.Exists(uVal) Then Exit For
        ' 首次存入:行号、T列值、计数1
        dict(uVal) = Array(sr, Data(sr, AVG_COLUMN), 1)
    Next sr
    
    ' 检查是否无重复项
    If sr > srCount Then
        MsgBox "无重复项。", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    Dim dr As Long: dr = sr - 1
    
    Dim wr As Long, wc As Long, c As Long
    Dim dictItem As Variant
    
    ' 从第一个重复项开始处理后续数据
    For sr = sr To srCount
        uVal = Data(sr, UNIQUE_COLUMN)
        If dict.Exists(uVal) Then ' 已存在:累加求和列,更新T列累计值和计数
            dictItem = dict(uVal)
            wr = dictItem(0) ' 获取存储的行号
            ' 累加求和列
            For c = 0 To sUpper
                wc = SumupColumns(c)
                Data(wr, wc) = Data(wr, wc) + Data(sr, wc)
            Next c
            ' 更新T列累计值和计数
            dictItem(1) = dictItem(1) + Data(sr, AVG_COLUMN)
            dictItem(2) = dictItem(2) + 1
            dict(uVal) = dictItem
        Else ' 不存在:写入整行数据,并存入字典
            dr = dr + 1
            dict(uVal) = Array(dr, Data(sr, AVG_COLUMN), 1)
            For c = 1 To cCount
                Data(dr, c) = Data(sr, c)
            Next c
        End If
    Next sr
    
    ' 计算所有唯一值的T列平均值
    Dim key As Variant
    For Each key In dict.Keys
        dictItem = dict(key)
        wr = dictItem(0)
        ' 避免除以0的情况
        If dictItem(2) > 0 Then
            Data(wr, AVG_COLUMN) = dictItem(1) / dictItem(2)
        Else
            Data(wr, AVG_COLUMN) = 0
        End If
    Next key
    
    ' 将处理后的数据写回工作表,并清除多余行
    Application.EnableEvents = False
    
    With srg.Resize(dr)
        .Value = Data
        .Resize(srCount - dr).Offset(dr).Clear
    End With
    
    Success = True
    
ProcExit:
    On Error Resume Next ' 防止后续错误导致死循环
        ' 确保事件始终启用
        If Not Application.EnableEvents Then Application.EnableEvents = True
        ' 提示完成
        If Success Then
  '  MsgBox "重复项已移除。", vbInformation, PROC_TITLE
        End If
    On Error GoTo 0
    Exit Sub
' 错误处理
ClearError:
    MsgBox "运行时错误 '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
  '  ActiveWindow.dispalyzeros = True                                            1
End Sub

修改说明:

  • 新增常量:定义AVG_COLUMN = 20对应T列,明确要计算平均值的目标列
  • 字典存储扩展:字典不再只存行号,改为存储包含「行号、T列累计值、出现次数」的数组,用于后续平均值计算
  • 重复项处理逻辑:遇到重复项时,除了累加求和列,同时累加T列的值并增加计数
  • 平均值计算:所有数据处理完成后,遍历字典对每个唯一值的T列累计值除以计数,得到平均值并写入对应行
  • 异常防护:添加除以0的判断,避免出现错误

内容的提问来源于stack exchange,提问作者Sead Hotic

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.15 08:14:51