时间戳

首页 > 解决方案 > 基于重复的总和值 - VBA

excel - 基于重复的总和值 - VBA

问题描述

我正在寻找能够：

  1. 在“A”列和格式中查找重复值。（可以使用下面的代码）
  2. 找到每个后续重复项后，代码应将“J”列到“N”列中的所有值求和第一个值，并将重复的单元格填充为黑色（帮助）
Sub CombineDuplicates()

Dim Cell As Variant
Dim PList As Range

lRow = Worksheets("Material Planning").Cells(Rows.Count, 1).End(xlUp).Row

Set PList = Worksheets("Material Planning").Range("A4:A" & lRow)

For Each Cell In PList
    
    'Checking whether value in cell already exist in the source range
    If Application.WorksheetFunction.CountIf(PList, Cell) > 1 Then
        
        'Highlight duplicate values in red color
        cRow = Cell.Row
        
        Range("A" & cRow & ":R" & cRow).Interior.Color = RGB(0, 0, 0)
    Else
        Cell.Interior.Pattern = xlNone
    End If
Next


End Sub

请参阅图片以供参考。顶部是未过滤的数据，底部是宏运行后的外观。如果您需要更多信息，请告诉我。提前致谢！

视图示例

标签： excelvbaformatting

解决方案

这使用字典来检测重复项和一个类来保持您的数据井井有条

将此部分放在类模块中：

Option Explicit

Private data As datasum
Private prow As Long
Private ptargetsheet As Worksheet

Private Type datasum
    thirtyday As Long
    threemonth As Long
    expectedusage As Double
    ordertarget As Double
    stock As Long
    avgdayleft As Long
    dayleft As Long
    pending As Long
End Type

Sub initialize(targetsheet As Worksheet, row As Long)
    Set ptargetsheet = targetsheet
    prow = row
End Sub

Sub addData(dataArray As Variant)
    data.thirtyday = data.thirtyday + dataArray(1, 1)
    data.threemonth = data.threemonth + dataArray(1, 2)
    data.expectedusage = data.expectedusage + dataArray(1, 3)
    data.ordertarget = data.ordertarget + dataArray(1, 4)
    data.stock = data.stock + dataArray(1, 5)
    data.avgdayleft = data.avgdayleft + dataArray(1, 6)
    data.dayleft = data.dayleft + dataArray(1, 8)
    data.pending = data.pending + dataArray(1, 9)
End Sub

Sub placeData()
    With ptargetsheet
        .Cells(prow, 6).Value = data.thirtyday
        .Cells(prow, 7).Value = data.threemonth
        .Cells(prow, 8).Value = data.expectedusage
        .Cells(prow, 9).Value = data.ordertarget
        .Cells(prow, 10).Value = data.stock
        .Cells(prow, 11).Value = data.avgdayleft
        .Cells(prow, 13).Value = data.dayleft
        .Cells(prow, 14).Value = data.pending
    End With
End Sub

这块在您的工作表模块或常规模块中：

Option Explicit

Sub CombineDuplicates()
    Dim i As Long
    Dim lRow As Long
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim data As DataClass
    
    With Sheets("Material Planning")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).row
        For i = 4 To lRow
            If Not dict.exists(.Cells(i, 1).Value) Then
                Set data = New DataClass
                data.initialize Sheets("Material Planning"), i
                data.addData .Range(.Cells(i, 6), .Cells(i, 14)).Value
                dict.Add .Cells(i, 1).Value, data
            Else
                dict(.Cells(i, 1).Value).addData .Range(.Cells(i, 6), .Cells(i, 14)).Value
                dict(.Cells(i, 1).Value).placeData
                .Range(.Cells(i, 1), .Cells(i, 14)).Interior.Color = RGB(0, 0, 0)
            End If
        Next i
    End With
        
End Sub

推荐阅读