# 汇总与另一列相关的唯一值的宏

[英]Macros to sum unique values related to another column

``````Sub unique()
Dim arr() As Variant
Dim arrElem As Variant
Dim Rng As Range
Dim elem As Range
Dim i As Long
Dim stepSum As Long
Dim match As Boolean

Set Rng = Range("B2:B20") 'Edit this so that it fits your array

'this sets up an array to store unique variables
ReDim Preserve arr(1 To 1) As Variant
arr(1) = 0

'this loops through each number in the identified range
For Each elem In Rng

'this is a boolean, false means the current number is unique (so far) true means the number has been seen previously.
match = False

'this checks the current number against all the unique values stored in the array
For Each arrElem In arr
'If it finds a match, it changes the boolean to true
If arrElem = elem Then match = True
Next arrElem

'If not match was found, we store the current number as a new unique value in the array
If match = False Then
'this adds another row to the array
ReDim Preserve arr(1 To UBound(arr) + 1) As Variant
arr(UBound(arr)) = elem.Value
End If

Next elem

'this sums the unique numbers we stored in the array
For i = 1 To UBound(arr)
stepSum = stepSum + arr(i)
Next i

'this reports the sum of unique elements
MsgBox stepSum

End Sub
``````

``````Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns( _
"B:B"), CopyToRange:=Range("'Sheet1'!K1"), Unique:=True
``````

``````For i = 2 To Cells(Rows.Count, 11).End(xlUp).Row
Cells(i, "L").FormulaR1C1 = "=SUMIF(C[-10],RC[-1],C[-3])"
Next i
``````