VBA多条件统计计数的问题

gzh491

xiangbaoan 发表于 2018-9-17 09:40
若行，可将附件发送到，我的用户名 艾特  qq  点  com，有空时义务帮忙再搞一下。

非常感谢，给您发过去了

xiangbaoan

把
        y = IIf(d.exists(br(r, 1)), d(br(r, 1)), d("其他"))
改成
y = IIf(Len(d(br(r, 1))), d(br(r, 1)), d("其他"))

gzh491

xiangbaoan 发表于 2018-9-17 11:09
把
        y = IIf(d.exists(br(r, 1)), d(br(r, 1)), d("其他"))
改成

非常感谢。

dajia1103

我也遇到相似问题，想解决

xiangbaoan

dajia1103 发表于 2018-9-17 17:03
我也遇到相似问题，想解决

请看10楼所说，无任何要求的。

excelvlookup

用这个吧，我把数据复制到6万+，用时不到一秒。我用03ex 所以60000+是极限
Sub aa()
Dim br, ar, cr
Set d = CreateObject("scripting.dictionary")
t = Timer
With Sheets("问题明细")
    rw = .Cells(Rows.Count, 1).End(3).Row
    ar = .Range("a2:d" & rw)
    br = .Range("h10:h38")
    hw1 = .[h2]: hw2 = .[h3]: hw3 = .[h4]
    'd.Add hw1, "hw1": d.Add hw2, "hw2": d.Add hw3, "hw3"
End With
For i = 1 To UBound(br)
    s = s + 1
    d(br(i, 1)) = i
Next
ReDim cr(2014 To 2018, 1 To 12, 1 To s + 3)
For i = 1 To UBound(ar)
    'If d(ar(i, 4)) <> "" Then
    If ar(i, 4) = hw1 Or ar(i, 4) = hw2 Or ar(i, 4) = hw3 Then
        r = d(ar(i, 1))
        If r = "" Then
            r = UBound(cr, 3) - 2
        End If
        hj = UBound(cr, 3) - 1
        cr(ar(i, 2), ar(i, 3), r) = cr(ar(i, 2), ar(i, 3), r) + 1
        cr(ar(i, 2), ar(i, 3), hj) = cr(ar(i, 2), ar(i, 3), hj) + 1
    End If
Next
With Sheets("生产数量")
    rw = .Cells(Rows.Count, 1).End(3).Row
    ar = .Range("a2:c" & rw)
End With
For i = 1 To UBound(ar)
    'If d(ar(i, 3)) <> "" Then
    If ar(i, 3) = hw1 Or ar(i, 3) = hw2 Or ar(i, 3) = hw3 Then
        y = Val(Split(ar(i, 1), ".")(0))
        m = Val(Split(ar(i, 1), ".")(1))
        cr(y, m, UBound(cr, 3)) = cr(y, m, UBound(cr, 3)) + ar(i, 2)
    End If
Next
ReDim br(1 To UBound(cr, 3), 1 To 60)
For i = 2014 To 2018
    For j = 1 To 12
        n = n + 1
        For k = 1 To UBound(cr, 3)
            br(k, n) = cr(i, j, k)
        Next
    Next
Next
MsgBox Timer - t
Sheets("问题明细").Range("i43").Resize(UBound(br), 60) = br
End Sub

dajia1103

xiangbaoan 发表于 2018-9-17 18:46
请看10楼所说，无任何要求的。

已经发送到邮箱，麻烦老师了