空格在最后一行也参加汇总

lufabao7788

[url=http://club.excelhome.net/home.php?mod=space&uid=3366630]Sub test()
    Set d = CreateObject("scripting.dictionary")
    With Sheets("第四次活动会员缴费表")
        r = .Cells(.Rows.Count, 13).End(3).Row
        arr = .Range("a8:p" & r)
    End With
    ReDim brr(1 To UBound(arr), 1 To 16)
    For x = 1 To UBound(arr)
        If Not d.Exists(arr(x, 13)) Then
            k = k + 1
            d(arr(x, 13)) = k
            For y = 1 To 16
                brr(k, y) = arr(x, y)
            Next
        Else
            m = m + 1
            m = d(arr(x, 13))
            brr(m, 7) = arr(x, 7) + brr(m, 7)
            brr(m, 11) = arr(x, 11) + brr(m, 11)
            For j = 14 To 15
                brr(m, j) = arr(x, j) + brr(m, j)
            Next
            brr(m, 16) = brr(m, 7) - brr(m, 14) - brr(m, 15)
    End If
Next
With Sheets("单条件多列汇总")
.Range("a8").Resize(k, 16) = brr
End With

End Sub
00707[/url]