关于统计汇总的问题

excelkill

根据b4栏科室名称，以及g4和h4栏的时间段，    从所有包含《a工作量统计表》名称的工作表里    统计这个时间段内，b4栏内这个科室业务事项的汇总统计到j和k栏里

   那位老师帮我看看如何解决，表格里其他问题，前期坛里老师帮助解决了，现在遇到这个问题，具体的问题描述，我在文件里作了详细说明。谢谢了。

excelkill

麻烦那位老师抽空帮我看看吧

limonet

关键字：between+group

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, Sht As Worksheet
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    For Each Sht In Worksheets
        If Sht.Name Like "*a工作量统计表" Then
            StrSQL = StrSQL & " Union All Select 业务事项 From [" & Sht.Name & "$D2:J] Where 所属科室='" & [B4] & "' And int(开始时间) Between #" & [G4] & "# And #" & [H4] & "#"
        End If
    Next Sht
    StrSQL = "Select 业务事项,Count(*) From (" & Mid(StrSQL, 12) & ") Group By 业务事项"
    Range("J5").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.24
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set sh = ThisWorkbook.Sheets("业务资料移交")
   
4.     st = "a工作量统计表"
   
5.     With sh
   
6.         ks = .[b4]
   
7.         rq1 = .[g4]
   
8.         rq2 = .[h4]
   
9.     End With
   
10.     For Each sht In Sheets
    
11.         If InStr(sht.Name, st) Then
    
12.             With sht
    
13.                 r = .Cells(Rows.Count, 4).End(3).Row
    
14.                 arr = .Range("a2:o" & r)
    
15.             End With
    
16.             For i = 2 To UBound(arr)
    
17.                 rq = Val(Format(arr(i, 4), "yyyymmdd"))
    
18.                 If rq >= rq1 And rq <= rq2 Then
    
19.                     s = arr(i, 9)
    
20.                     If Not d.exists(s) Then
    
21.                         d(s) = Array(s, 1)
    
22.                     Else
    
23.                         t = d(s)
    
24.                         t(1) = t(1) + 1
    
25.                         d(s) = t
    
26.                     End If
    
27.                 End If
    
28.             Next
    
29.         End If
    
30.     Next
    
31.     With sh
    
32.         .[j5:k1000].Clear
    
33.         .[j5].Resize(d.Count, 2) = Application.Rept(d.Items, 1)
    
34.         .[j5].Resize(d.Count, 2).Borders.LineStyle = 1
    
35.     End With
    
36.     Set d = Nothing
    
37.     MsgBox "OK！"
    
38. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

excelkill

limonet 发表于 2024-1-24 14:38
关键字：between+group

谢谢，稍后鲜花奉上

excelkill

ykcbf1100 发表于 2024-1-24 14:49
附件供参考。。。

谢谢老师，每回都能得到你的解答

excelkill

ykcbf1100 发表于 2024-1-24 14:49
附件供参考。。。

你好老师，代码测试过了，提取的数据是全部业务事项的汇总数据，没有按照科室来汇总提取，麻烦老师帮助修改一下，谢谢了

ykcbf1100

excelkill 发表于 2024-1-24 16:51
你好老师，代码测试过了，提取的数据是全部业务事项的汇总数据，没有按照科室来汇总提取，麻烦老师帮助修 ...

改好了，少加了一个条件。