Question

最近，作为一种激发我好奇心的方法，我试图了解如果使用VBA语言编写的本机Excel函数将如何工作。我正在使用的一种这样的功能是SUMIF

仅当条件为“等于” =运算符时，我才能编写代码以复制SUMIF的确切功能。我对于如何更改代码以适应其他{@ {1}}，>=等运算符感到困惑。

这是我到目前为止的发展。

<=

您知道SUMIF动态地安排运营商例如：

Function SUMIF_VBA(Crit_Rng As Range, Condition_U As Variant, Sum_Rng As Range)

R_Offset = Sum_Rng.Row - Crit_Rng.Row
C_Offset = Sum_Rng.Column - Crit_Rng.Column

SUMIF_VBA = 0

For Each Cell In Crit_Rng

If Cell.Value = Condition_U Then
SUMIF_VBA = SUMIF_VBA + Cell.Offset(R_Offset, C_Offset).Value

End If

Next Cell

End Function

如果相应的A列值大于或等于10，此代码将自动计算C列中的值总和。

我想在SUMIF代码中包含相同的功能。

感谢您的帮助。

Answer 1

退房！

Function test_sumif(c_a As Range, c_b As String, c_c As Range)
n = 1

For Each r In c_a

If Application.Evaluate(r.Value & c_b) Then
 test_sumif = test_sumif + c_c(n, 1).Value
End If

n = n + 1
Next

End Function

它与原始sumif函数一样接近该功能。虽然没有处理可选的sumrange部分。

Answer 2

这里有一些想法：

'This function returns the filtered array to the caller, so that it may sum, concat, average or whatever
Private Function GetFilteredArray(leftArgRange As Range, condition As Variant, Optional sumRange As Range) As Variant()
    Dim sumArray() As Variant, leftArgArray() As Variant

    If leftArgRange.Cells.CountLarge > 1 Then
        leftArgArray = Intersect(leftArgRange.Worksheet.UsedRange, leftArgRange).Value2
    ElseIf leftArgRange.Cells.Count = 1 Then
        leftArgArray = Array(leftArgRange.Cells(1, 1).Value2)
    Else
        Exit Function   'return empty array
    End If

    If sumRange Is Nothing Then
        sumArray = leftArgArray
    Else
        sumArray = Intersect(sumRange.Worksheet.UsedRange, sumRange).Value2
    End If

    Dim filteredArr() As Variant
    ReDim filteredArr(0 To leftArgRange.Cells.Count - 1)

    Dim v As Variant
    Dim i As Long, j As Long, filteredCount As Long

    For i = LBound(leftArgArray) To UBound(leftArgArray)
        For j = LBound(leftArgArray, 2) To UBound(leftArgArray, 2)
            If Compare(leftArgArray(i, j), condition) Then
                filteredArr(filteredCount) = sumArray(i, j)
                filteredCount = filteredCount + 1
            End If
        Next j
    Next i

    If filteredCount > 0 Then
        ReDim Preserve filteredArr(0 To filteredCount - 1)
        GetFilteredArray = filteredArr
    End If

End Function

Private Function Compare(leftArg As Variant, condition As Variant) As Boolean
    On Error Resume Next
    Dim rightArg As Variant
    If VarType(condition) = vbString Then
        'parse String
        If condition Like ">=*" Then
            rightArg = Mid(condition, 3)
            Compare = leftArg >= IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like "<=*" Then
            rightArg = Mid(condition, 3)
            Compare = leftArg <= IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like ">*" Then
            rightArg = Mid(condition, 2)
            Compare = leftArg > IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like "<*" Then
            rightArg = Mid(condition, 2)
            Compare = leftArg < IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like "**LIKE**" Then
            rightArg = Mid(condition, 7)
            Compare = InStr(1, leftArg, rightArg, vbTextCompare) > 0
        Else
            'assume equals
            rightArg = condition
            Compare = leftArg = rightArg
        End If
    Else
        'assume other primitive/struct such as Date, numeric, boolean etc
        rightArg = condition
        Compare = leftArg = rightArg
    End If

End Function

从工作表中调用：

Public Function VBA_SUMIF(leftArgRange As Range, condition As Variant, Optional sumRange As Range) As Double
    Dim filteredArr() As Variant
    filteredArr = GetFilteredArray(leftArgRange, condition, sumRange)

    On Error Resume Next
    Dim i As Long, total As Double
    For i = LBound(filteredArr) To UBound(filteredArr)
        total = total + filteredArr(i)
    Next i

    VBA_SUMIF = total
End Function

Public Function VBA_CONCATIF(leftArgRange As Range, condition As Variant, Optional sumRange As Range, Optional delimiter As String = "") As String
    Dim filteredArr() As Variant
    filteredArr = GetFilteredArray(leftArgRange, condition, sumRange)

    VBA_CONCATIF = Join(filteredArr, delimiter)
End Function

Public Function VBA_COUNTIF(leftArgRange As Range, condition As Variant) As Long
    Dim filteredArr() As Variant
    filteredArr = GetFilteredArray(leftArgRange, condition)

    On Error Resume Next
    VBA_COUNTIF = UBound(filteredArr) - LBound(filteredArr) + 1
End Function

Answer 3

您可以在 VBA 中使用许多工作表功能。说我们的数据就像：

我们放入了一个标准模块：

Public Function Vsumif(crrange As Range, crit As String, which As Range)
    With Application.WorksheetFunction
        Vsumif = .SumIf(crrange, crit, which)
    End With
End Function

，然后在某些单元格中输入：

=vsumif(A:A,">=10",C:C)

它将产生正确的结果。

要在子项中使用 UDF（）：

Sub demo()
    Dim x As Variant

    x = Vsumif(Range("A:A"), ">=10", Range("C:C"))
    MsgBox x
End Sub

Answer 4

这是一种可能性。它不会按照您的要求使用“评估”。

Function SUMIF_VBA(Crit_Rng As Range, Condition_U As Variant, Sum_Rng As Range)

R_Offset = Sum_Rng.Row - Crit_Rng.Row
C_Offset = Sum_Rng.Column - Crit_Rng.Column

SUMIF_VBA = 0

Call ParseCondition(Condition_U, Cond_out, Criteria_out)
For Each Cell In Crit_Rng

SumThis = False
Select Case Cond_out
    Case 3
        If Cell.Value = Criteria_out Then
            SumThis = True
        End If
    Case 5
        If Cell.Value > Criteria_out Then
            SumThis = True
        End If
    Case 7
        If Cell.Value < Criteria_out Then
            SumThis = True
        End If
    Case 8
        If Cell.Value >= Criteria_out Then
            SumThis = True
        End If
    Case 10
        If Cell.Value <= Criteria_out Then
            SumThis = True
        End If
    Case 12
        If Cell.Value <> Criteria_out Then
            SumThis = True
        End If
End Select

If SumThis Then
    SUMIF_VBA = SUMIF_VBA + Cell.Offset(R_Offset, C_Offset).Value
End If

Next Cell

End Function

Private Sub ParseCondition(Cond_in, Cond_out, Criteria_out)

    '* Evaluate the condition and set a unique number on each condition
    Cond_out = 0
    If InStr(Cond_in, "=") Then
      Cond_out = Cond_out + 3
    End If

    If InStr(Cond_in, ">") Then
      Cond_out = Cond_out + 5
    End If

    If InStr(Cond_in, "<") Then
      Cond_out = Cond_out + 7
    End If

    Set SDI = CreateObject("VBScript.RegExp")
    SDI.Pattern = "\d+"  '* keep the number only
    Set Num_out = SDI.Execute(Cond_in)
    Criteria_out = Val(Num_out(0))


End Sub

如何在VBA中编写克隆SUMIF函数？

4 个答案: