Excel基于C列重复值合并AB列数据至AD列（VBA/公式实现）

VBA实现方案 #

这个方案通过字典分组收集唯一页码，再批量填充，效率高且能避免重复值：

Sub MergeDuplicatePackPages()
    Dim Proofsheet As Worksheet
    Dim lr As Long, i As Long
    Dim packDict As Object
    Dim currentPack As String, currentPage As String
    
    Set Proofsheet = ActiveSheet ' 可替换为指定工作表，比如ThisWorkbook.Sheets("你的表名")
    lr = Proofsheet.Cells(Proofsheet.Rows.Count, "C").End(xlUp).Row
    Set packDict = CreateObject("Scripting.Dictionary")
    
    ' 第一步：按C列Pack值分组，收集对应唯一页码
    For i = 2 To lr
        currentPack = Proofsheet.Cells(i, "C").Value
        currentPage = Proofsheet.Cells(i, "AB").Value
        
        If packDict.Exists(currentPack) Then
            ' 仅添加未存在的页码，避免重复
            If InStr(1, packDict(currentPack), currentPage, vbTextCompare) = 0 Then
                packDict(currentPack) = packDict(currentPack) & ", " & currentPage
            End If
        Else
            packDict(currentPack) = currentPage
        End If
    Next i
    
    ' 第二步：批量填充AD列
    For i = 2 To lr
        currentPack = Proofsheet.Cells(i, "C").Value
        Proofsheet.Cells(i, "AD").Value = packDict(currentPack)
    Next i
    
    Set packDict = Nothing
    Set Proofsheet = Nothing
End Sub

代码说明 #

• 用Scripting.Dictionary自动按Pack值分组，天然去重键值
• 遍历中检查页码是否已存在，确保合并结果无重复项
• 分两步处理（先收集后填充）比逐行判断效率更高

公式实现方案（适用于Excel 365/2021） #

如果不想用VBA，可在AD2单元格输入以下公式，下拉填充：

=TEXTJOIN(", ", TRUE, UNIQUE(FILTER($AB$2:$AB$1000, $C$2:$C$1000=C2)))

公式说明 #

• FILTER($AB$2:$AB$1000, $C$2:$C$1000=C2)：筛选当前行Pack值对应的所有AB列页码
• UNIQUE()：去除筛选结果中的重复页码
• TEXTJOIN(", ", TRUE, ...)：用逗号加空格合并所有唯一页码，自动忽略空值

关于你之前尝试的问题 #

• 你用的COUNTIFS仅能判断当前页码是否为该Pack下的唯一值，没有聚合合并的逻辑，无法直接实现需求
• 之前的VBA代码逻辑错误，没有按Pack分组收集页码，反而错误引用了AD列内容，导致无法正确识别对应页码

内容的提问来源于stack exchange，提问作者Deke