vba - 对具有多个条件的唯一值求和

Question

你好，
我需要一个等效的公式来根据某些标准对唯一值求和。
我想要的结果在 E 列中.有 2 个条件(第 D 列上的第一个条件和第二个条件，列 B 必须是 ">10"。
现在我使用这个公式:{=SUM(IF(FREQUENCY(IF($A$2:$A$10=D2,IF($B$2:$B$10>10,MATCH($B$2:$B$10,$B$2:$B$10,0))),ROW($B$2:$B$10)-ROW($B$2)+1),$B$2:$B$10))}这个公式的问题是它不能用 FormulaArray 设置。在 VBA .我知道我可以使用evaluate提取结果，但我想要的只是在列 E 的每个单元格上都有一个公式，即可以计算正确。
谢谢 !

Answer 1

在找到一种可行的方法之前，我必须尝试几种方法，但我想通了。
将这些函数粘贴到模块中:

Public Function SumIfIf(rgeData As Range, matchCriteria As String, numCompCriteria As String) As Double

    Dim c As Range, arr_Distinct() As String, x As Long, totalOut As Double, str_ConcatRgeRow As String
    ReDim arr_Distinct(0)
    
    totalOut = 0
    If InStr("<>=", Left(numCompCriteria, 1)) = 0 Then numCompCriteria = "=" & numCompCriteria

    For Each c In rgeData.Columns(1).Cells
        str_ConcatRgeRow = c.Value & c.Offset(0, rgeData.Columns.Count - 1).Value
        If Not IsInArray(arr_Distinct, str_ConcatRgeRow) Then
            ReDim Preserve arr_Distinct(UBound(arr_Distinct) + 1)
            arr_Distinct(UBound(arr_Distinct)) = str_ConcatRgeRow
            If Evaluate(c.Value = matchCriteria) And Evaluate("=(" & c.Offset(0, rgeData.Columns.Count - 1).Value & numCompCriteria & ")") Then
                totalOut = totalOut + c.Offset(0, rgeData.Columns.Count - 1).Value
            End If
        End If
    Next c
    
    SumIfIf = totalOut

End Function

Function IsInArray(arrToCheck As Variant, valToFind As Variant) As Boolean
    Dim x As Long
    IsInArray = False
    For x = 1 To UBound(arrToCheck)
        If arrToCheck(x) = valToFind Then IsInArray = True
    Next x
End Function

在您的示例中，您可以像这样使用它:

Usage:

SumIfIf(rgeData As Range, matchCriteria As String, numCompCriteria As String)

rgeData = a range of any number of rows and at least 2 columns

The function matches:

• the left-most column for exact matches to 'matchCriteria', and

• the right-most column for matches to 'numCompCriteria'

...and then:

• returns the sum of numCompCriteria matches

• where [matchCriteria] + [numCompCriteria] is unique.

matchCriteria = a text or numeric identifier, to be matched exactly

numCompCriteria = a numeric identifier specific as a string starting with > or < or = like you would specify simple criteria for the SumIf worksheet function.

• Examples of numCompCriteria: "=10", "<=10", "10"

我在一天的屏幕时间限制；如果您需要进一步的解释，请告诉我。同时希望这可以解决您的问题。 :)
+1 对挑战的问题，它的好处是我正在做的事情正是我所需要的!

更新，进一步@BOB的问题:
进行比较的代码行是这一行:

If Evaluate(c.Value = matchCriteria) And Evaluate("=(" & c.Offset(0, rgeData.Columns.Count - 1).Value & numCompCriteria & ")") Then

因此，根据您的需要，有几种方法可以更改它。
快速而肮脏，如果您的新标准是永久性的，请将上面的行替换为:

If Evaluate(c.Value = matchCriteria) _
    And Evaluate("=(" & c.Offset(0, rgeData.Columns.Count - 1).Value & ">10" & ")") _
    And Evaluate("=(" & c.Offset(0, rgeData.Columns.Count - 1).Value & "<=35" & ")") _
    Then

请注意，这不会使用 numCompCriteria 的值。不再，但您仍然必须指定某些内容，否则从函数声明中删除参数。或者，调整它为您的新标准添加更多参数。
按照该模式，您可以添加您喜欢的所有标准。这里使用它的方式，“ Evaluate”返回 True 或 False。您可以通过以下方式进行演示:

debug.print Evaluate ("=(10>35)")

在上面的代码中

c.Offset(0, rgeData.Columns.Count - 1).Value

返回最右边列的值。