123
返回列表 上一主題 發帖

[發問] 用VBA來執行SUMPRODUCT多條件統計

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
21# 跳轉到 »
發表於 2013-5-10 17:17 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 受人點水之恩，須當湧泉以報。
123
返回列表 上一主題