Excel：添加重複行的一個字段並刪除重複行

我有很多從公司工具中獲取的數據，而且我需要重複行的幫助。我對VBA和Excel相當陌生，所以請耐心等待。Excel：添加重複行的一個字段並刪除重複行

有四列：

帳戶|項目|設備|

卷

我需要幫助寫一個宏，確實順序如下：

第一行中比較帳戶名到下一行。
如果帳號名稱相同，則比較兩個項目的名稱。
如果項目名稱相同，則比較兩個設備名稱。
如果設備名稱相同，則會添加卷並刪除第二行。
它重複此操作直到它達到數據的底部。

這裏是它應該是什麼樣子的例子：

開始數據：

最終的數據應該是這樣的：

任何幫助你可以提供將是美好的。謝謝！

來源

2016-01-18 zaanwar

而你需要/只需要VBA？您可以使用數據透視表來做到這一點...... –

是的，它必須由VBA完成。數據需要採用標準的Excel單元格格式才能與其他公司工具一起使用。 – zaanwar

據我所見，這是一個3嵌套循環解決方案。您應該循環搜索第一列，直到找到相同的單元格內容，然後循環搜索第二列，直到找到相同的單元格內容，然後再次在第三列中執行相同的操作，最後在第三個循環內執行單元格的平均值。將平均值保存到一個數組，並保存在該數組中前三列中找到的單元格內容。 – gmeroni

此代碼應幫助....

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的所有數據進行排序是非常重要的。每列從最後一列開始。

並添加了一條評論...

來源

2016-01-18 17:39:48

像魅力一樣工作。謝謝！ – zaanwar

這就能做到：

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，然後刪除重複。然後在第一列中，它提供了SUMIFS（）公式的值。

來源

2016-01-18 17:29:54

Excel：添加重複行的一個字段並刪除重複行

回答

相關問題