Question

我想编写一个函数，该函数将基于多个条件求和。这是我的尝试，但我意识到，我不能多次使用相同的值进行“大小写”过程。

我可以将每个求和值分离到不同的函数，但是我将需要40个求和值。（3个不同类别的条件，从每个类别中有时使用一个条件，有时使用多个条件）您有更好的主意或优雅的解决方案吗？

谢谢

Function suma_data() As Variant
Dim row As Integer
row = 2
Dim returnVals(10) As Double
Dim all As Double
Dim voc As Double
Dim cvc As Double
Dim ms1 As Double
Dim ms2 As Double
Dim mv As Double
Dim metped As Double
Dim ssi As Double
Dim nsc As Double
Dim siov As Double


Sheets("data").Select
Do Until Sheets("data").Cells(row, 1).Value = ""
    Select Case Cells(row, 2).Value
        Case Is = "0922", "09604"
           all = all + Cells(row, 4)
        Case Is = "09223", "09224"
            voc = voc + Cells(row, 4)
        Case Is = "0950"
            cvc = cvc + Cells(row, 4)
        Case Is = "0113", "0980"
            If Cells(row, 3) = "00164381" Or Cells(row, 3) = "42137004" Then
                ms1 = ms1 + Cells(row, 4)
            End If
        Case Is = "0133", "0810", "0820"
            If Cells(row, 3) = "00164381" Then
                ms2 = ms2 + Cells(row, 4)
        Case Is = "0980"
            If Cells(row, 3) = "00151866" Then
                mv = mv + Cells(row, 4)
            End If
        Case Is = "0980"
            If Cells(row, 3) = "00164348" Or Cells(row, 3) = "30807506" Then
                metped = metped + Cells(row, 4)
            End If
        Case Is = "0980"
            If Cells(row, 3) = "31797857" Or Cells(row, 3) = "42134943" Then
                ssi = ssi + Cells(row, 4)
            End If
        Case Is = "0810", "0980"
            If Cells(row, 3) = "30853923" Then
                nsc = nsc + Cells(row, 4)
            End If
        Case Is = "0980"
            If Cells(row, 3) = "17314852" Then
                siov = siov + Cells(row, 4)
            End If

    End Select
    row = row + 1
Loop
returnVals(1) = all
returnVals(2) = voc
returnVals(3) = cvc
returnVals(4) = ms1
returnVals(5) = ms2
returnVals(6) = mv
returnVals(7) = metped
returnVals(8) = ssi
returnVals(9) = nsc
returnVals(10) = siov
suma_data = returnVals
End Function

Answer 1

那呢？希望我没有错过您的任何原始条件：

Select Case Cells(Row, 2)
Case "0922", "09604"
    all = all + Cells(Row, 4)
Case "09223", "09224"
    voc = voc + Cells(Row, 4)
Case "0950"
    cvc = cvc + Cells(Row, 4)
Case "0113"
    Select Case Cells(Row, 3)
       Case "00164381", "42137004"
          ms1 = ms1 + Cells(Row, 4)
       Case "00164381"
          ms2 = ms2 + Cells(Row, 4)
    End Select
Case "0980"
    Select Case Cells(Row, 3)
        Case "00164381", "42137004"
           ms1 = ms1 + Cells(Row, 4)
        Case "00151866"
           mv = mv + Cells(Row, 4)
        Case "00164348", "30807506"
            metped = metped + Cells(Row, 4)
        Case "31797857", "42134943"
            ssi = ssi + Cells(Row, 4)
        Case "30853923"
            nsc = nsc + Cells(Row, 4)
        Case "17314852"
           siov = siov + Cells(Row, 4)
    End Select
Case "0810"
    Select Case Cells(Row, 3)
        Case "00164381"
            ms2 = ms2 + Cells(Row, 4)
        Case "30853923"
            nsc = nsc + Cells(Row, 4)
        End Select
Case "0820"
    If Cells(Row, 3) = "00164381" Then
        ms2 = ms2 + Cells(Row, 4)
    End If
End Select

Answer 2

如果使用“更强的解决方案”，则表示不及以下：是的，这是一种更优雅的解决方案。

想法是编写一个函数，该函数将接受1到3个条件，如果在相应类别中为每个条件找到匹配值，则返回一个值，否则该函数将返回0。

getConditionalValue（）：函数

如果条件在“类别”值中，则返回一个值

Function getConditionalValue(value As Double, _
                             Optional Condition1 As String, Optional Category1 As Variant, _
                             Optional Condition2 As String, Optional Category2 As Variant, _
                             Optional Condition3 As String, Optional Category3 As Variant) As Double

    If Not IsMissing(Category1) Then If UBound(Filter(Category1, Condition1, True, vbBinaryCompare)) = -1 Then Exit Function
    If Not IsMissing(Category2) Then If UBound(Filter(Category2, Condition2, True, vbBinaryCompare)) = -1 Then Exit Function
    If Not IsMissing(Category3) Then If UBound(Filter(Category3, Condition3, True, vbBinaryCompare)) = -1 Then Exit Function

    getConditionalValue = value
End Function

重构循环

Do Until Sheets("data").Cells(row, 1).value = ""
    all = all + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0922", "09604"))

    voc = voc + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("09223", "09224"))

    cvc = cvc + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0950"))

    ms1 = ms1 + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0113", "0980"), _
                                    Cells(row, 3), Array("00164381", "42137004"))

    ms2 = ms2 + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0133", "0810", "0820"), _
                                    Cells(row, 3), Array("00164381"))

    mv = mv + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0980"), _
                                  Cells(row, 3), Array("00151866"))

    metped = metped + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0980"), _
                                          Cells(row, 3), Array("00164348", "30807506"))

    ssi = ssi + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0980"), _
                                    Cells(row, 3), Array("31797857", "42134943"))

    nsc = nsc + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0810", "0980"), _
                                    Cells(row, 3), Array("30853923"))

    siov = siov + getConditionalValue(Cells(row, 4), Cells(row, 2).value, Array("0980"), _
                                      Cells(row, 3), Array("17314852"))
Loop

VBA-根据多个条件求和

2 个答案:

getConditionalValue（）：函数

重构循环