求助如何做日统计

月落天涯

向大神求助如何做日统计，希望达成的效果是：在日统计表K2单元格输入日期并点击按钮，自动统计该日期所有成品的发货总量，表中模拟了2024-8-25的发货统计。谢谢各位大神，有鲜花。

cidanji

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = Sheets("明细").[a3].CurrentRegion
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To UBound(arr), 1 To 6)
rq = Sheets("日统计").[k2]
For i = 2 To UBound(arr)
   If arr(i, 3) = rq Then
      If Not d.exists(arr(i, 4)) Then
         m = m + 1
         brr(m, 1) = m
         For j = 2 To 4
            brr(m, j) = arr(i, j + 2)
         Next
         brr(m, 5) = arr(i, 8)
         brr(m, 6) = arr(i, 11)
         d(arr(i, 4)) = m
      Else
         r = d(arr(i, 4))
         brr(r, 5) = brr(r, 5) + arr(i, 8)
      End If
   End If
Next
If m > 0 Then
   With Sheets("日统计")
      .[a3].CurrentRegion.Offset(1).ClearContents
      .[a4].Resize(m, 6) = brr
   End With
End If
Set d = Nothing
End Sub

扇扇扇

练习练习练习

Qs18

Sub qs()
Dim arr, i, dic, sj
sj = CDate(Sheet2.[k2].Value)
arr = Sheet1.Range("a4").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 6)
Set dic = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
    s = arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6)
    If CDate(arr(i, 3)) = sj Then
        If Not dic.exists(s) Then
            m = m + 1
            dic(s) = m
            brr(m, 1) = m
            For j = 1 To 3
                brr(m, j + 1) = arr(i, j + 3)
            Next
            brr(m, 5) = arr(i, 8)
        Else
            r = dic(s)
            brr(r, 5) = brr(r, 5) + arr(i, 8)
        End If
    End If
Next
With Sheet2
    .Range("a3").Offset(1).Resize(1000, 6).ClearContents
    .Range("a4").Resize(m, 6) = brr
End With
End Sub

Qs18

试试..........

笨鸟飞不高

ykcbf1100

明细表和日统计表的字段请保持一致。
附件供参考。。。

ykcbf1100

用字典固定列号

1. Sub ykcbf()   '//2024.8.28
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("日统计")
   
5.         c1 = .Cells(3, "XFD").End(1).Column
   
6.         rq = CDate(.[k2].Value)
   
7.         For j = 2 To c1
   
8.             s = .Cells(3, j).Value
   
9.             d(s) = j
   
10.         Next
    
11.         .[a4].Resize(10000, 26) = ""
    
12.     End With
    
13.     ReDim brr(1 To 10000, 1 To c1)
    
14.     With Sheets("明细")
    
15.         r = .Cells(Rows.Count, 1).End(3).Row
    
16.         c = .Cells(3, "XFD").End(1).Column
    
17.         arr = .[a1].Resize(r, c)
    
18.         For i = 4 To UBound(arr)
    
19.             If CDate(arr(i, 3)) = rq Then
    
20.                 m = m + 1
    
21.                 brr(m, 1) = m
    
22.                 For j = 1 To UBound(arr, 2)
    
23.                     s = arr(3, j)
    
24.                     If d.exists(s) Then
    
25.                         brr(m, d(s)) = arr(i, j)
    
26.                     End If
    
27.                 Next
    
28.             End If
    
29.         Next
    
30.     End With
    
31.     If m > 0 Then Sheets("日统计").[a4].Resize(m, c1) = brr
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "OK！"
    
34. End Sub
    
35. 
    

复制代码

kyxfyzg

仅供参考。。。。。。。