VBA代码添加重复项并删除

Question

我真的被困在这种形式的代码。 我想创建一个命令按钮，使用户可以简化报告并合并所有类似的项目并删除重复项。这将用于购买请求。我已经附加形式的照片在这里 - > Form

我需要的按钮，找到C列的重复和F列求和汇总，然后用删除重复离开原来的背后总数量在QTY菜单中。这是可能的并且仍然保持在同一张纸上，还是将它复制到新纸上会更好？

Answer 1

如果键是列C，这个宏应该做你想做的事，把它附加到按钮上。为了使它很容易多变的键列，我所定义的键为一个常数，它现在设置为3（列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

没有看到你的代码，它很难说你坚持什么，但这里是如何寻找重复和总结的价值简单的例子

我使用WorksheetFunction.Match Method (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 

Answer 3

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