EXCEL VBA:使用SUMIF公式将多个范围压缩到一行

时间:2017-11-14 23:36:22

标签: excel vba

我有以下几行代码用SUMIF公式填充特定范围:

Range("B7").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B8").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B9").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B12").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B13").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B17").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B21").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B22").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B23").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B24").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B25").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B29").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B30").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B31").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B32").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B33").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"
Range("B37").FormulaR1C1 = "=SUMIF(R2C13:R500C13,RC[-1],R2C12:R500C12)"

我很难将上面的代码行变成更短的代码,如下面的代码所示。我收到相同的答案,但我不确定如何使用多个范围进行编码。

Dim Sumact As Range

Set Sumact = Sheets("IS Branch 12").Range("B7")

Sumact = Application.sumif(Range("M2:M500"),Range("A7"),Range("L2:L500"))

3 个答案:

答案 0 :(得分:1)

为什么不这样试试?

Dim Rng As Range
Set Rng = Range("B7:B9,B12:B13,B17,B21:B25,B29:B33,B37")
Rng.Formula = "=SUMIF($M$2:$M$500,A7,$L$2:$L$500)"
Rng.Value = Rng.Value

答案 1 :(得分:0)

为了使它更短,您可以像这样设置范围值;

[B7:B9,B12:B13,B17,B21:B25,B29:B33,B37].Formula = "=SUMIF($M$2:$M$500,A7,$L$2:$L$500)"

[]是范围对象的快捷方式

答案 2 :(得分:0)

我认为您希望将计算减少到单个代码行。您可以使用SUM(SUMIF(...,...,...))公式,但一系列条件值需要是一个数组,而不是单元格,最好删除重复项。

=sum(sumifs(L2:L500, M2:M500, {1, 2, 3, 4, 5}))

在代码中,在删除重复值时将不连续范围内的值收集到数组中,

Dim a As Long, arr As Variant, rng As Range
ReDim arr(30)  'total 31 possible values before duplicate removal

For Each rng In Range("a7:a9,a12:a13,a17,a21:a25,a29:a33,a37")
    Debug.Print rng.Address
    If IsError(Application.Match(rng.Value2, arr, 0)) Then
        arr(a) = rng.Value2
        a = a + 1
    End If
Next rng
ReDim Preserve arr(a - 1)
Debug.Print Application.Sum(Application.SumIfs(Range("L2:L500"), Range("M2:M500"), arr))

Dim Sumact As Range
Set Sumact = Sheets("IS Branch 12").Range("B7")
Sumact = Application.Sum(Application.SumIfs(Range("L2:L500"), Range("M2:M500"), arr))