VBA代码添加重复和删除

我真的被困在这个表单的代码。 我想创build一个命令button，将允许用户简化报告，并结合所有类似的项目，并删除重复。 这将使用一个购买请求。 我在这里附上了表格的照片 – > 表格

我需要button来findC列中的重复项，然后总计F列中的总数，然后在QTY菜单中删除重复项，并保留原来的总数。 这是可能的，仍然保持在同一张纸上，或者它会更好地重复到一个新的表？

Answer 1

如果键是列C ，这个macros应该做你想要的，附加到button。 为了使键列更容易变化，我将键定义为一个常量，现在将其设置为3（col C）：

 Sub ProcessForm() Dim wholeRange As Range, i As Long, ar Const key As Long = 3 ' <-- column C is key. Set to 1 if col A With Worksheets("Order") Set wholeRange = .Range("A5:G" & .Cells(.Rows.Count, key).End(xlUp).row) End With With wholeRange ar = .Columns(key).value For i = 1 To UBound(ar) ar(i, 1) = WorksheetFunction.SumIfs(.Columns(6), .Columns(key), ar(i, 1)) Next .Columns(6).value = ar .RemoveDuplicates key End With End Sub 

Answer 2

 Sub main() Dim cell As Range With Worksheets("Order") With .Range("C5", .Cells(.Rows.Count, 3).End(xlUp)) For Each cell in .Cells cell.Offset(,3).Value = WorksheetFunction.SumIf(.Cells, cell, .Offset(,3)) Next .Offset(, -2).Resize(, 7).RemoveDuplicates Columns:=Array(3), Header:=xlNo End With End With End Sub 

Answer 3

没有看到你的代码很难说什么你卡住，但这里是如何search重复和总结价值的快速例子

我正在使用WorksheetFunction.Match方法（Excel）

 Option Explicit Sub Example() ' // Declare Variables Dim DupRow As Variant Dim i As Long Dim LastRow As Long Dim Sht As Worksheet Set Sht = ThisWorkbook.Sheets("Sheet1") With Sht LastRow = .Cells(Rows.Count, "C").End(xlUp).Row For i = LastRow To 2 Step -1 ' // Columns 3 (C) DupRow DupRow = Application.Match(Cells(i, 3).Value, Range(Cells(1, 3), Cells(i - 1, 3)), 0) If Not IsError(DupRow) Then ' // Columns 6 (F) sum Match Cells(i, 6).Value = Cells(i, 6).Value + Cells(DupRow, 6).Value Rows(DupRow).Delete ' Delete DupRow End If Next i End With End Sub