Question

我真的卡在这个表单的代码上。我想创建一个命令按钮，允许用户简化报告并组合所有类似的项目并删除重复项。这将用于购买请求。我附上了这张表格的照片 - ＆gt; Form

我需要按钮在C列中找到重复项，并将F列中的总计相加，然后删除重复项，将原始文件放在QTY菜单中。这可能并且仍然保持在同一张纸上，或者将它复制到新纸张会更好吗？

Answer 1

如果键是列C，则此宏应该执行您想要的操作，将其附加到按钮。为了使密钥列容易更改，我将密钥定义为常量并立即将其设置为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

如果没有看到你的代码就很难说出你所坚持的内容，但这里有关于如何搜索重复项并将值加总的快速示例

我正在使用 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

VBA代码添加重复项并删除

3 个答案: