Question

您好我正在尝试在工作表上使用所有唯一的不同名称和金额，我正在尝试创建一个收集所有名称并汇总其旁边付款的宏。名称在A栏和B栏上的付款中，我需要C-Name和D-Total列中的总和。

这是如何在VBA中完成的。

谢谢。

Answer 1

请尝试以下代码：

Sub sumTotal()

    'dim array to store unique names
    Dim uniqueArray As Variant

    'Sheets(your chosen sheet)
    With Sheets(1)

        'find last cell with value in A
        Set last = .Range("A:A").Find("*", Cells(1, 1), searchdirection:=xlPrevious)

        'for each cell in column to last value found
        For n = 1 To last.Row
            'if name isnt in array yet
            If Not InArray(.Cells(n, 1).Value, uniqueArray) Then

                'check if array is empty redim/resize array and attribute value
                If IsEmpty(uniqueArray) Then
                    ReDim uniqueArray(0)
                    uniqueArray(0) = .Cells(n, 1).Value
                Else
                    ReDim Preserve uniqueArray(0 To UBound(uniqueArray) + 1)
                    uniqueArray(UBound(uniqueArray)) = .Cells(n, 1).Value
                End If
            End If
        Next

        'for each of the gathered names
        For n = 0 To UBound(uniqueArray)
            'set name in column C
            .Cells(n + 1, 3).Value = uniqueArray(n)
            'set value of application sum if column D
            .Cells(n + 1, 4).Value = Application.WorksheetFunction.SumIf(Range("A:A"), uniqueArray(n), Range("B:B"))
        Next
    End With
End Sub
Function InArray(val As String, arr As Variant) As Boolean

    'set default value of InArray
    InArray = False
    If IsEmpty(arr) Then Exit Function

    'for each name in array
    For n = 0 To UBound(arr)
        'if name is found
        If val = arr(n) Then
            'return true
            InArray = True
            'ext function earlier
            Exit Function
        End If
    Next
End Function

使用行的thouthands对列的唯一名称求和

1 个答案: