SUMPRODUCT函数 瘦身

KCFONG

Sub 统计表()

Sheets("统计表").Select
Rows("3:65536").ClearContents
'统计上个月的数据
mm = DateSerial(Year(Range("a1")), Month(Range("a1")), Day(Range("a1")))
mm1 = DateSerial(Year(Range("c1")), Month(Range("c1")), Day(Range("c1")))

Set dic = CreateObject("SCRIPTING.DICTIONARY") 'NAME

Set DIC2 = CreateObject("SCRIPTING.DICTIONARY")
Set DIC3 = CreateObject("SCRIPTING.DICTIONARY")

Rng = Sheets("登记表").[A5].CurrentRegion
For r = 3 To UBound(Rng)

  If Rng(r, 1) >= mm And Rng(r, 1) <= mm1 Then
     Y = Rng(r, 1)

     For c = 2 To UBound(Rng, 2)
       If Rng(1, c) <> "" Then
            X = Rng(1, c)
         
            If Rng(r, c - 1) <> "" Then
                    Z = X & "," & Rng(2, c - 1) '& "餐餐数" '阮永乾 早"
                    DIC2(Z) = DIC2(Z) + 1
                   If IsNumeric(Rng(r, c - 1)) Then DIC3(Z) = DIC3(Z) + Rng(r, c - 1)
                     dic(X) = ""
            End If
            
            If Rng(r, c) <> "" Then
                    Z = X & "," & Rng(2, c)  '阮永乾 早
                    DIC2(Z) = DIC2(Z) + 1
                    If IsNumeric(Rng(r, c)) Then DIC3(Z) = DIC3(Z) + Rng(r, c)
                     dic(X) = ""
            End If
            
            If Rng(r, c + 1) <> "" Then
                    Z = X & "," & Rng(2, c + 1) '阮永乾 早
                    DIC2(Z) = DIC2(Z) + 1
                     If IsNumeric(Rng(r, c + 1)) Then DIC3(Z) = DIC3(Z) + Rng(r, c + 1)
                     dic(X) = ""
            End If
       End If
     Next c
  End If
  

Next
If dic.Count > 0 Then
[A3].Resize(dic.Count, 1) = Application.Transpose(dic.KEYS)

For r = 3 To dic.Count + 2
  For c = 2 To 6 Step 2
     Y = Cells(r, 1) & "," & Replace(Cells(2, c), "餐餐数", "")
     Cells(r, c) = DIC2(Y)
     Cells(r, c + 1) = DIC3(Y)
  
  
  Next c

Next r
End If
End Sub

a1520541

http://club.excelhome.net/thread-1585415-1-1.html  请老师帮我看看这个帖子，写一下vba