请求修改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
相关产品推荐
相关产品推荐

