Excel：添加一个重复行字段并删除重复行答案

【问题标题】：Excel: Adding one field of duplicate rows and deleting duplicate rowsExcel：添加一个重复行字段并删除重复行
【发布时间】：2016-01-19 02:01:59
【问题描述】：

我有很多从公司工具中提取的数据，我需要有关重复行的帮助。我对 VBA 和 Excel 还很陌生，所以请多多包涵。

有四列：

帐户 |项目 |设备 |音量

我需要帮助编写一个按此顺序执行以下操作的宏：

将第一行中的帐户名称与下一行进行比较。
如果账户名相同，则比较两个项目名字。
如果项目名称相同，则比较两者设备名称。
如果设备名称相同，则添加卷并删除第二行。
它会重复此操作，直到到达数据的底部。

这是一个应该是什么样子的示例：

起始数据：

最终的数据应该是这样的：

您能提供的任何帮助都会很棒。谢谢！

【问题讨论】：

而您只需要/想要 VBA 吗？您可以使用数据透视表来做到这一点...
是的，它必须由 VBA 完成。数据需要采用标准 Excel 单元格格式才能与其他一些公司工具一起使用。
据我所知，这是一个 3 嵌套循环解决方案。您应该循环遍历第一列直到找到相同的单元格内容，然后循环遍历第二列直到找到相同的单元格内容，然后在第 3 列中再次执行相同的操作，最后在第 3 列中进行单元格的平均值.将平均值保存到一个数组中，并将您在该数组的前 3 列中找到的单元格内容保存。

标签： vba excel duplicates

【解决方案1】：

这段代码应该会有所帮助....

Sub likePivot()
Dim r
Dim i As Range
Dim j
Dim rng As Range
Dim Comp
Dim Proj
Dim Devi
Dim A
Dim B
Dim C
Dim D
    A = 1
    B = 2
    C = 3
    D = 4
    r = Range("A2").End(xlDown).Row 'This is to know the end of the data
    j = 1 'just an index
    Do
        j = j + 1
        Comp = Cells(j, A).Value 'This is justo to set the code clear (the IF's)
        Proj = Cells(j, B).Value
        Devi = Cells(j, C).Value
        If Comp = Empty Then Exit Sub 'If reach the end of the data, exit
        If Comp = Cells(j + 1, A) Then 'if the company is equal to the next one
            If Proj = Cells(j + 1, B) Then 'If the Project is equal to the next one
                If Devi = Cells(j + 1, C) Then 'If the Device is equal to the next one
                        Cells(j, D).Value = Cells(j, D).Value + Cells(j + 1, D).Value 'Add the value of the next one
                        Cells(j + 1, D).EntireRow.Delete 'Delete the next line.
                        j = j - 1
                End If
            End If
        End If
    Loop While Comp <> 0 'If the Company row has something, do it again and again until the end of times
End Sub

我认为你想删除重复的行，但如果你想将数据放在其他列中，你可以告诉我并修改答案。

编辑#1

如果您想看到好的结果，重要的是从 A-Z 对所有数据进行排序。每列从最后一列开始。

并在一行中添加了注释...

【讨论】：

工作就像一个魅力。谢谢！

【解决方案2】：

这样就可以了：

Sub sumdevice()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim cel As Range
Dim lstRow As Long

Set ws = Sheets("Sheet11") 'change this to your sheet name
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, 3).End(xlUp))

rng.Copy ws.Range("F1")

Set rng2 = ws.Range(ws.Cells(1, 6), ws.Cells(ws.Rows.Count, 8).End(xlUp))
With rng2
    .Value = .Value
    .RemoveDuplicates Array(1, 2, 3), xlYes
End With

ws.Range("I1").Value = "Volume"
lstRow = ws.Range("H" & ws.Rows.Count).End(xlUp).Row

Set rng2 = ws.Range("I2:I" & lstRow)
For Each cel In rng2
    cel.Value = ws.Evaluate("=SUMIFS($D:$D,$A:$A," & cel.Offset(, -3).Address(0, 0) & ",$B:$B," & cel.Offset(, -2).Address(0, 0) & ",$C:$C," & cel.Offset(, -1).Address(0, 0) & ")")
Next cel

End Sub

它基本上将 A-C 列中的数据复制并粘贴到 F-H 中，然后删除重复项。然后在 I 列中输入 SUMIFS() 公式的值。

【讨论】：