用于汇总与另一列相关的唯一值的宏答案

【问题标题】：Macros to sum unique values related to another column用于汇总与另一列相关的唯一值的宏
【发布时间】：2018-05-30 10:32:52
【问题描述】：

我需要创建宏以填充“指标计算器”选项卡，即每个“研究”（D 列）的“测试步骤数”（G 列）的总和。总和应仅考虑唯一值。请看下表：

在这项研究中，编号为“1111”，总步骤编号/患者编号“20”重复 3 次，“15”重复 4 次，“30”重复 3 次——我需要宏来获取唯一值并添加，即只有 20+15+30=65。

在度量计算器选项卡中“- 它应该带有输出为

Study no 总步数 1111 65

【问题讨论】：

您的“总步数”是 20 还是 1、2、3？第三列的标题是“总步数？患者编号”，但您指的是第二列中的数字....
extendoffice.com/documents/excel/… - 尝试实施，然后返回您可能遇到的任何问题。

标签： excel excel-formula vba

【解决方案1】：

因此，如果我理解了这个问题，您想对 B 列中的唯一值求和。下面的方法可以解决问题。

请注意，您需要根据需要调整范围。现在范围设置为 B2:B20，如您的示例表中所示。

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
        'this adds the unique value
        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

【讨论】：

【解决方案2】：

查看此示例：

在我们的示例中，“B 列”中的单元格（供应商名称）被列为“K 列”中的唯一值：

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

后来，为了对“L”列中的这些项目（I列中的金额）求和，我们使用循环将SUMIF公式输入到L列中的单元格：

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

来源：Excel vba sum unique items

【讨论】：