识别列、添加数量、删除重复项答案

【问题标题】：Identify columns, add quantites, delete duplicates识别列、添加数量、删除重复项
【发布时间】：2021-06-12 13:12:46
【问题描述】：

我正在编译电气设备的 BOM。我总共有 18 个 BOMS，每个 BOMS 大约有 160 个项目。我正在寻找一种代码，它可以扫描所有数据并识别重复项，获取它们的值，将它们相加，然后删除重复项。此代码我已识别并删除，但我无法将其添加到数量...

    Sub RemoveDuplicates()

    Dim lastrow As Long

    lastrow = Cells(Rows.Count, "B").End(xlUp).Row

    For x = lastrow To 1 Step -1
        For y = 1 To lastrow
            If Cells(x, 1).Value = Cells(y, 1).Value And Cells(x, 2).Value = Cells(y, 2).Value And x > y Then
                Cells(y, 3).Value = Cells(x, 3).Value + Cells(y, 3).Value
                Rows(x).EntireRow.Delete
                Exit For
            End If
        Next y
    Next x

End Sub

【问题讨论】：

您能否提供一些示例数据来支持您当前的代码为minimal reproducible example？
导管 - EMT 1" 320...导管 - EMT 1-1/2" 50.......导管 - EMT 2" 120......导管 - EMT 3 " 180 导管 - EMT 1" 120........ 导管 - EMT 1-1/2" 30..... 导管 - EMT 2" 300.... 导管 - EMT 3" 25... .
项目名称为 A 列，数量为 B 列

标签： vba rollup quantities

【解决方案1】：

你可以使用Dictionary object:

Option Explicit

Sub RemoveDuplicates()
    Dim lastRow As Long, x As Long, strval As String, storedRow As Long
    Dim toDel As Range  ' collects rows to delete
    Dim dict As Object  ' Dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    
    With ThisWorkbook.Worksheets("Sheet1") ' replace with your own WB and WS
        lastRow = Cells(Rows.Count, "B").End(xlUp).Row
        For x = 1 To lastRow
            strval = .Cells(x, 1).Text & "|" & .Cells(x, 2).Text    ' make a key
            If dict.Exists(strval) Then ' check if this string value has been encountered before
                storedRow = dict(strval)    'retrieve the saved row number
                .Cells(storedRow, 3) = .Cells(storedRow, 3) + .Cells(x, 3)
                If toDel Is Nothing Then
                    Set toDel = .Cells(x, 1)
                Else
                    Set toDel = Union(.Cells(x, 1), toDel)
                End If
            Else
                dict.Add strval, x    'make the new entry in the Dictionary: key = string, value = row number
            End If
        Next x
        If Not toDel Is Nothing Then toDel.EntireRow.Delete
    End With
End Sub

之前

之后

【讨论】：

【解决方案2】：

如果您可以输入两个帮助列或将数据复制到其他工作表并这样做，如下图所示，您可能不需要VBA。

只需输入公式，将其复制下来，粘贴值，然后过滤 c 列并删除超过 1 个计数的行。

【讨论】：