将UDF应用于用作sumproduct范围的每个值

时间:2017-04-25 15:23:08

标签: excel vba excel-vba

我在VBA中编写了一个UDF,它接受一个参数和一个字符串并处理它们以返回一个double。我希望能够使用这个公式来处理sumproduct公式中的范围表的列,我遇到了一些问题。

Public Function ColorCount(Color As String, ToCount As String)
Dim WordArray() As String
ToCount = Replace(ToCount, " ", "")
WordArray() = Split(ToCount, "}{")
ColorCount = 0
For i = LBound(WordArray) To UBound(WordArray)
    WordArray(i) = Replace(WordArray(i), "{", "")
    WordArray(i) = Replace(WordArray(i), "}", "")
    If UCase(Color) = UCase(WordArray(i)) Then
        ColorCount = ColorCount + 1
    ElseIf UCase(WordArray(i)) Like UCase(Color) & "[/\]*" Or UCase(WordArray(i)) Like "*[/\]" & UCase(Color) Then
        ColorCount = ColorCount + 0.5
    End If
Next i
End Function

我在表格中有数据,我希望能够为总和产品调用。我尝试过与=sumproduct(Table[Quant],ColorCount("Color", Table[Colors])类似的东西,但它似乎不起作用。

任何建议或帮助都将不胜感激!

1 个答案:

答案 0 :(得分:0)

将所有处理写入UDF。如果不利用VBA中可用的优势(与SUMPRODUCT相比),这似乎是一种耻辱。

Option Explicit

Public Function udfColorCount(theColor As String, toCount As Range, toQty As Range)
    Dim c As Integer, i As Integer, colorString As String, colorArray As Variant
    'toCount = Replace(toCount, " ", vbNullString)
    udfColorCount = 0
    For c = 1 To toQty.Cells.Count
        Debug.Print toCount.Cells(c).Value2
        colorString = Replace(toCount.Cells(c).Value2, Chr(32), vbNullString)
        colorArray = Split(Mid(colorString, 2, Len(colorString) - 2), "}{")
        For i = LBound(colorArray) To UBound(colorArray)
            If UCase(theColor) = UCase(colorArray(i)) Then
                udfColorCount = udfColorCount + toQty.Cells(c)
            ElseIf CBool(InStr(1, colorArray(i), theColor, vbTextCompare)) Then
                udfColorCount = udfColorCount + 0.5 * toQty.Cells(c)
            End If
        Next i
    Next c
End Function

enter image description here