求助各位大神，如何实现多条件多时间段的计数汇总

lsdongjh

先将现有的数据转换成 三列或四列： 配件类型、录入时间、作业类型，就可以直接用 SQL ，进行交叉表查询，一步到位了

lsdongjh

1. Option Explicit
   
2. 
   
3. Sub Test()
   
4.     Dim strShName As String, strFieldsName As String, strSplit() As String
   
5.     Dim SH As Worksheet, rgAdd As Range, rgResult As Range
   
6.     Dim lngRows_Old As Long, lngRows_New As Long
   
7.     Dim arrOld As Variant, arrAdd As Variant
   
8.     Dim lngRow As Long, lngCol As Long
   
9.     Dim lngIndex As Long
   
10.    
    
11.     Dim Conn As Object, Rst As Object, strPath As String
    
12.     Dim strConn As String, strSQL As String
    
13.    
    
14.     strShName = "Sheet1"
    
15.     Set SH = Sheets(strShName)
    
16.     lngRows_Old = SH.Range("A" & Rows.Count).End(xlUp).Row
    
17.     If lngRows_Old < 2 Then Exit Sub
    
18.    
    
19.     lngRows_New = (lngRows_Old - 1) * 2
    
20.    
    
21.     arrOld = SH.Range("A2:H" & lngRows_Old)
    
22.     ReDim arrAdd(1 To lngRows_New, 1 To 4)
    
23.     lngIndex = 1
    
24.    
    
25.     For lngRow = LBound(arrOld) To UBound(arrOld)
    
26.         For lngCol = 5 To 8 Step 2
    
27.             If arrOld(lngRow, lngCol) <> "" Then
    
28.                 arrAdd(lngIndex, 1) = arrOld(lngRow, 1)
    
29.                 arrAdd(lngIndex, 2) = arrOld(lngRow, 2)
    
30.                 arrAdd(lngIndex, 3) = arrOld(lngRow, lngCol)
    
31.                 arrAdd(lngIndex, 4) = arrOld(lngRow, lngCol + 1)
    
32.                 lngIndex = lngIndex + 1
    
33.             End If
    
34.         Next
    
35.     Next
    
36.    
    
37.    
    
38.     Set rgAdd = SH.Range("A" & lngRows_Old + 1).Resize(lngRows_New, 4)
    
39.     rgAdd = arrAdd
    
40.    
    
41.     Set rgResult = SH.Range("K1")
    
42.    
    
43.     Set Conn = CreateObject("ADODB.Connection")
    
44.     Set Rst = CreateObject("ADODB.Recordset")
    
45.     strPath = ThisWorkbook.FullName
    
46.     Select Case Application.Version * 1
    
47.         Case Is <= 11
    
48.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
    
49.         Case Is >= 12
    
50.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
51.     End Select
    
52. 
    
53.     Conn.Open strConn
    
54. 
    
55.     '''''''''''''''''''''''''''''''''
    
56.     strSQL = "TRANSFORM Count(一作业类型) AS 计数 " & _
    
57.              "SELECT Format([一录入时间],'yyyy/mm/dd') AS 日期, 飞机配件型号 " & _
    
58.              "FROM [" & strShName & "$B:D] " & _
    
59.              "GROUP BY Format([一录入时间],'yyyy/mm/dd'), 飞机配件型号 " & _
    
60.              "ORDER BY Format([一录入时间],'yyyy/mm/dd') " & _
    
61.              "PIVOT 一作业类型;"
    
62. 
    
63.     Rst.Open strSQL, Conn, 3, 1
    
64.    
    
65.     For lngCol = 0 To Rst.Fields.Count - 1
    
66.         strFieldsName = strFieldsName & "|" & Rst.Fields(lngCol).Name
    
67.     Next
    
68.    
    
69.     strSplit = Split(Mid(strFieldsName, 2), "|")
    
70.    
    
71.     SH.Range("K:W").ClearContents
    
72.    
    
73.     '标题
    
74.     rgResult.Resize(1, UBound(strSplit) + 1) = strSplit
    
75.     '内容
    
76.     rgResult.Offset(1, 0).CopyFromRecordset Rst
    
77. 
    
78.     Set Rst = Nothing
    
79.     Set Conn = Nothing
    
80.    
    
81.     rgAdd.ClearContents
    
82. End Sub
    
83. 
    

复制代码

jackylam

mikezhan 发表于 2018-7-31 11:59
1.只针对“一录入时间",你那个多列数据最好先转化成一列。
2.你表中，那个” Local Repair ", 搞成了” Lo ...

不好意思，录入出错了，谢谢您。

刚运行了下
显示第十三行运行出错

jackylam

lsdongjh 发表于 2018-7-31 12:14

谢谢大神，这个可以用