VBA求和行基于不同的两个条件和删除行

Question

我想创建一个宏，该宏将按 Product & DC 对单位列基数求和。它将填充出相同的产品名称、带 dc 代码的代码和不带 dc 代码的代码。

Sub Button1_Click()

For i = 2 to lstrow

Next I

MsgBox ("Done")

End Sub

Product	DC	Unit
ABC	0	2
ABC	1234	4
ABC	1234	4
DEF	5678	2
DEF	5678	2
GHI	9012	2

我想输出如下：-

Product	Unit with DC Code	Unit Without DC Code
ABC	6	2
DEF	4	0
GHI	2	0

Answer 1

总和唯一

• 调整常量部分中的值。
• 如果您想覆盖（'模仿'RemoveDuplicates），只需将Sheet2 替换为Sheet1 并取消注释Delete below 部分。请注意，您将无法撤消。

守则

Option Explicit

Sub sumUnique()
    
    ' Define constants.
    Const sName As String = "Sheet1"
    Const sFirstCellAddress As String = "A2"
    Const dName As String = "Sheet2"
    Const dFirstCellAddress As String = "A1"
    
    ' Define workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Write values from Source Range to Data Array.
    Dim LastRow As Long
    Dim Data As Variant
    With wb.Worksheets(sName).Range(sFirstCellAddress)
        LastRow = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row
        Data = .Resize(LastRow - .Row + 1, 3)
    End With
    
    ' Write unique values from Data Array to Unique Dictionary.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    Dim arr(1 To 2) As Variant
    Dim Key As Variant
    Dim cArr As Variant
    Dim r As Long
    For r = 1 To UBound(Data, 1)
        Key = Data(r, 1)
        If Not IsError(Key) Then
            If Not dict.Exists(Key) Then
                dict.Add Key, arr
            End If
            If Data(r, 2) = 0 Then
                cArr = dict(Key)
                cArr(2) = cArr(2) + Data(r, 3)
                dict(Key) = cArr
            Else
                cArr = dict(Key)
                cArr(1) = cArr(1) + Data(r, 3)
                dict(Key) = cArr
            End If
        End If
    Next r
    
    ' Write values from Unique Dictionary to Result Array.
    Dim rCount As Long: rCount = dict.Count + 1
    Dim Result As Variant: ReDim Result(1 To rCount, 1 To 3)
    Result(1, 1) = "Product"
    Result(1, 2) = "Unit With DC Code"
    Result(1, 3) = "Unit Without DC Code"
    If rCount > 1 Then
        r = 1
        For Each Key In dict.Keys
            r = r + 1
            Result(r, 1) = Key
            Result(r, 2) = CLng(dict(Key)(1))
            Result(r, 3) = CLng(dict(Key)(2))
        Next Key
    End If
    
    ' Write values from Result Array to Destination Range.
    With wb.Worksheets(dName).Range(dFirstCellAddress).Resize(, 3)
        .Resize(rCount).Value = Result
        ' Delete below.
        '.Resize(.Worksheet.Rows.Count - .Row - rCount + 1) _
            .Offset(rCount).ClearContents
    End With
    
End Sub

Answer 2

下面是一个 VBA 代码示例，应该可以做到这一点：

Sub SubWhyNotSUMIFS()
    
    'Declarations.
    Dim RngResult As Range
    Dim RngTarget As Range
    Dim RngSource As Range
    Dim StrPreviousProduct As String
    
    'Settings.
    Set RngResult = Range("D1")
    Set RngSource = Range("A2:C2")
    Set RngSource = Range(RngSource, RngSource.End(xlDown))
    
    'Creating space for the result.
    RngResult.EntireColumn.Insert
    RngResult.EntireColumn.Insert
    RngResult.EntireColumn.Insert
    
    'Reporting the headers of the result list.
    Set RngResult = RngResult.Offset(0, -3)
    RngResult.Value = "Product"
    RngResult.Offset(0, 1) = "Unit with DC Code"
    RngResult.Offset(0, 2) = "Unit Without DC Code"
    
    'Covering each cell of the first column of RngSource.
    For Each RngTarget In RngSource.Columns(1).Cells
        
        'Checking if it's a different product.
        If StrPreviousProduct <> RngTarget.Value Then
            
            'Setting RngResult for a new row.
            Set RngResult = RngResult.Offset(1, 0)
            
            'Changing StrPreviousProduct.
            StrPreviousProduct = RngTarget.Value
            
            'Reporting the results.
            RngResult.Value = RngTarget.Value
            RngResult.Offset(0, 1).Value = Excel.WorksheetFunction.SumIfs(RngSource.Columns(3), RngSource.Columns(1), RngTarget.Value, RngSource.Columns(2), "<>0")
            RngResult.Offset(0, 2).Value = Excel.WorksheetFunction.SumIfs(RngSource.Columns(3), RngSource.Columns(1), RngTarget.Value, RngSource.Columns(2), 0)
            
        End If
    Next
    
End Sub

您可以对其进行逆向工程。您最感兴趣的行是：

RngResult.Offset(0, 1).Value = Excel.WorksheetFunction.SumIfs(RngSource.Columns(3), RngSource.Columns(1), RngTarget.Value, RngSource.Columns(2), "<>0")
RngResult.Offset(0, 2).Value = Excel.WorksheetFunction.SumIfs(RngSource.Columns(3), RngSource.Columns(1), RngTarget.Value, RngSource.Columns(2), 0)

翻译成实际的公式基本上是这样的：

=SUMIFS(C2:C7,A2:A7,D2,B2:B7,"<>0")
=SUMIFS(C2:C7,A2:A7,D2,B2:B7,"=0")

假设您的列表从单元格 A1（标题）到单元格 C7，则在单元格 D2 中有您正在寻找的独特产品。代码本身动态地覆盖列表。由于看起来您的列表是他们自己的列中唯一的内容，因此公式如下：

=SUMIFS(C:C,A:A,D2,B:B,"<>0")
=SUMIFS(C:C,A:A,D2,B:B,"=0")

应该仍然有效。