GBKEE

回復 20# b9208
附檔 Ex()程序不是 8# 的Ex()程序

1. Option Explicit
   
2. Dim D(1 To 3) As Object, 週次 As Object, Ar '        'Dim : 此模組的私用變數(僅此模組可用)
   
3. Sub EX()
   
4.     Dim i As Integer, ii As Integer, M As String, Rng As Range, 統計單位 As Variant
   
5.     Set D(1) = CreateObject("scripting.dictionary")    '字典物件
   
6.     Set D(2) = CreateObject("scripting.dictionary")
   
7.     Set D(3) = CreateObject("scripting.dictionary")
   
8.     Set 週次 = CreateObject("scripting.dictionary")
   
9.     With Sheets("統計")
   
10.         i = Application.CountA(.[b4:b13])
    
11.         統計單位 = Join(Application.Transpose(.Range(.[b4], .[b4].Offset(i - 1))), ",")        '統計單位=QWE,ASD
    
12.     End With
    
13.     With Sheets("明細")
    
14.         i = 6
    
15.         Do While .Cells(i, "D") <> ""
    
16.             ' "," & 統計單位 & "," -> ,QWE,ASD,
    
17.             If InStr("," & 統計單位 & ",", "," & .Cells(i, "F") & ",") Then   '比對到  ,QWE,   ,ASD, .....
    
18.                 M = .Cells(i, "D") & .Cells(i, "E") & .Cells(i, "F") & .Cells(i, "L")
    
19.                 If D(3)(M) = "" Then   ' *** 這裡判斷4欄都相同為一筆資料 ****
    
20.                     D(3)(M) = 0
    
21.                     If InStr("," & 週次(.Cells(i, "F").Value) & ",", "," & Mid(.Cells(i, "E"), 1, 4)) & "," = 0 Then '統計單位: 比對週次不存在, .....
    
22.                         週次(.Cells(i, "F").Value) = IIf(週次(.Cells(i, "F").Value) = "", "", 週次(.Cells(i, "F").Value) & ",") & Mid(.Cells(i, "E"), 1, 4)
    
23.                     End If
    
24.                     M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F")
    
25.                     D(1)(M) = D(1)(M) + 1                                                               '全部
    
26.                     M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F") & .Cells(i, "L")
    
27.                     D(2)(M) = D(2)(M) + 1                                                               '區域
    
28.                 End If
    
29.             End If
    
30.             i = i + 1
    
31.         Loop
    
32.     End With
    
33.     With Sheets("統計")
    
34.         .[F:IQ].Clear
    
35.         For i = 0 To Application.CountA(.Range("B4:B13")) - 1
    
36.             Ar = Array("全部", "單位", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun", "小計")
    
37.             If i = 0 Then
    
38.                 Set Rng = .[F3]
    
39.             Else
    
40.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '每張表格間隔五列
    
41.             End If
    
42.            
    
43.             週次(.Range("B4").Offset(i).Value) = Split(週次(.Range("B4").Offset(i).Value), ",")
    
44.             '取得統計單位之週次
    
45.    
    
46.             表格製造 Rng, .Range("B4").Offset(i)
    
47.             表格統計 Rng.CurrentRegion
    
48.             
    
49.             For ii = 0 To Application.CountA(.Range("B18:B21")) - 1
    
50.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '每張表格間隔五列
    
51.                 Ar(0) = .[B18].Offset(ii)
    
52.                 表格製造 Rng, .Range("B4").Offset(i)
    
53.                 表格統計 Rng.CurrentRegion
    
54.             Next
    
55.     Next
    
56. End With
    
57. End Sub

複製代碼