Question

我有很多从公司工具中提取的数据，我需要有关重复行的帮助。我是VBA和Excel的新手，所以请耐心等待。

共有四列：

帐户|项目|设备|体积

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

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

以下是它应该是什么样子的示例：

启动数据：

最终数据应如下所示：

你能提供的任何帮助都会很精彩。谢谢！

Answer 1

这样做：

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（）公式的值放入。

Answer 2

此代码应该有帮助......

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中的所有数据进行排序。每列从最后一列开始。

并在一行中添加评论......

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

2 个答案: