使用 方方格子工具箱 里面的 分类汇总功能即可实现。

回复：楼主

hello,打开VBA 复制以下代码 ,注意{原始表和目标表格的名称如有需要需要自己替换一下},亲测 OK 跑的正常.

Sub MergeDuplicates()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim lastRow As Long
    Dim i As Long
    
    ' 定义源表和目标表
    Set wsSource = Sheets("Sheet1") ' 源表
    Set wsDestination = Sheets("Sheet2") ' 目标表
    
    ' 获取源表数据范围
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    Set sourceRange = wsSource.Range("A2:D" & lastRow) ' 假设数据从第2行开始
    
    ' 遍历源表数据，并合并去重
    For Each cell In sourceRange.Columns(1).Cells
        ' 判断身份证、姓名和科室都相同的行是否已存在于目标表中
        If Application.WorksheetFunction.CountIfs(wsDestination.Columns(1), cell.Value, wsDestination.Columns(2), cell.Offset(0, 1).Value, wsDestination.Columns(3), cell.Offset(0, 2).Value) = 0 Then
            ' 找到与当前行身份证、姓名和科室相同的行
            ' 注意：这里假设身份证在第1列，姓名在第2列，科室在第3列
            Set destinationRange = wsDestination.Cells(wsDestination.Rows.Count, 1).End(xlUp).Offset(1, 0)
            
            ' 复制行数据到目标表
            cell.Resize(, 4).Copy destinationRange
        End If
    Next cell
End Sub

回复：4楼

比自带的分类汇总好用，功能更加灵活点

回复：33楼

求一个EXCELde VB代码，打开文件强制启用宏，不启用无法查看文件内容，文件到期自动销毁。

牛逼

在下面表中，是我用完去重合并后 ，订单号我想向右侧一般合并成这样能做到吗？

学习到了  非常感谢！