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

我有很多从公司工具中​​提取的数据，而且我需要重复行的帮助。 我对VBA和Excel相当新，所以请耐心等待。

有四列：

帐户| 项目| 设备| 卷

我需要帮助写一个macros，按照以下顺序执行以下操作：

1. 将第一行中的帐户名称与下一行进行比较。
2. 如果帐号名称相同，则比较两个项目名称。
3. 如果项目名称相同，则比较两个设备名称。
4. 如果设备名称相同，则添加卷并删除第二行。
5. 它重复这个，直到它达到了数据的底部。

这是一个应该看起来像什么的例子：

启动数据：

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

任何帮助你可以提供将是美好的。 谢谢！

Answer 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

如果你想看到好的结果，sorting来自AZ的所有数据是很重要的。 每列从最后一列开始。

并添加了一条评论…

Answer 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 

它基本上将Col列AC中的数据复制并粘贴到FH中，然后删除重复项。 然后在第一列中，它提供了一个SUMIFS（）公式的值。