[已解决]如何用VBA和函数统计中饭晚饭数量

菜鸟出茅庐

中饭：大于0.46天小于0.55天算中饭，即11点到13点之间
晚饭：大于0.67天为晚饭，即16点以后

最佳答案

月排行榜 / 总排行榜

grf1973

2015-3-26 11:28

按你的表式搞了段统计代码。结果可以和备份结果比对一下，完全一致。

跳转到最佳答案楼层

baksy

F2单元格复制以下公式，下拉；
=IF(MOD(D2,1)>16/24,"晚饭","中饭")

菜鸟出茅庐

baksy 发表于 2015-3-25 15:18
F2单元格复制以下公式，下拉；
=IF(MOD(D2,1)>16/24,"晚饭","中饭")

我是想算出每天吃饭的份数，就是我上面统计出来的那个数量，您说的F2在我的表中没有哦

grf1973

1. Sub 导入()
   
2.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\车队.xls")
   
3.     [a3:e1000].ClearContents
   
4.     wb.Sheets(1).UsedRange.Offset(1, 0).Copy [a3]
   
5.     wb.Close False
   
6. End Sub
   
7. 
   
8. Sub 统计()
   
9.     arr = Sheet1.Range("a3:e" & Sheet1.[a65536].End(3).Row)
   
10.     Set d = CreateObject("scripting.dictionary")
    
11.     For i = 1 To UBound(arr)
    
12.         sj = arr(i, 4)       '表中时间：年月日时分秒
    
13.         rq = DateSerial(Year(sj), Month(sj), Day(sj))        '提取日期
    
14.         hh = Hour(sj)       '提取小时
    
15.         If hh >= 11 And hh <= 13 Then bb = "中" Else If hh >= 16 Then bb = "晚"   '班别
    
16.         If arr(i, 5) = 6 Then dd = "句容" Else dd = "南京"     '地点
    
17.         x = dd & rq & bb        '地点+日期+班别为key
    
18.         d(x) = d(x) + 1
    
19.     Next
    
20.    
    
21.     For k = 1 To 2     '结果计算
    
22.         If k = 1 Then brr = [f1:bj3] Else brr = [f9:bj11]
    
23.         For j = 2 To UBound(brr, 2)
    
24.             If Len(brr(1, j)) = 0 Then brr(1, j) = brr(1, j - 1)
    
25.             x = brr(1, 1) & brr(1, j) & brr(2, j)         '地点+日期+班别为key
    
26.             brr(3, j) = d(x)
    
27.         Next
    
28.         If k = 1 Then [f1:bj3] = brr Else [f9:bj11] = brr
    
29.     Next
    
30. End Sub
    

复制代码

grf1973

导入时由于“车队.xls”的版本问题，要在安全性里重新设置一下。

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%
   
3. arr = Range("a1").CurrentRegion
   
4. y = Year([d2]): m = Month([d2])
   
5. t = Day(DateSerial(2015, m + 1, 0))
   
6. ReDim brr(1 To t + 1, 1 To 5)
   
7. For i = 2 To UBound(arr)
   
8.     x = Split(arr(i, 4))
   
9.     d = Day(x(0)): sj = x(1)
   
10.     If Val(arr(i, 5)) = 6 Then
    
11.         If sj > "11:00:00" And sj < "14:00:00" Then brr(d, 4) = brr(d, 4) + 1
    
12.         If sj > "16:00:00" Then brr(d, 5) = brr(d, 5) + 1
    
13.     Else
    
14.         If sj > "11:00:00" And sj < "14:00:00" Then brr(d, 2) = brr(d, 2) + 1
    
15.         If sj > "16:00:00" Then brr(d, 3) = brr(d, 3) + 1
    
16.     End If
    
17. Next
    
18. For i = 1 To t
    
19.     brr(i, 1) = DateSerial(y, m, i)
    
20.     For j = 2 To 5
    
21.         brr(t + 1, j) = brr(t + 1, j) + brr(i, j)
    
22.     Next
    
23. Next
    
24. brr(t + 1, 1) = "合计"
    
25. [g3:h100] = ""
    
26. Range("g3").Resize(UBound(brr), 5) = brr
    
27. End Sub

复制代码

菜鸟出茅庐

grf1973 发表于 2015-3-25 15:39

能否按照我的格式做呢，而且我有很多工作表，如何能实现呢？您的按钮指定插入一个固定的！

菜鸟出茅庐

dsmch 发表于 2015-3-25 16:01

能否按照我的格式做呢？而且我有好多工作表的，我以前是用函数做的，现在VBA是在看不太懂！！！

雪舞子

可以用透视表直接汇总，快速方便



test.rar (18.74 KB, 下载次数: 3)

2015-3-25 18:05 上传

点击文件名下载附件

菜鸟出茅庐

菜鸟出茅庐 发表于 2015-3-25 16:27
能否按照我的格式做呢？而且我有好多工作表的，我以前是用函数做的，现在VBA是在看不太懂！！！

您的说法木有错，但是我这些表做完后还有张汇总表，格式不能改的！