- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
40#
發表於 2016-2-1 11:48
| 只看該作者
回復 38# 藍天麗池 - Sub 統計() ' L、M、N、O 欄位統計
- Dim DD As Date
-
- dicStatics
- DD = Format(Now, "yyyy/mm/dd hh:mm") ' DD = 2016/1/28 上午 12:41:00 : Date
- TimeTxt = DD + 1 / 1440 ' TimeTxt = 2016/1/28 上午 12:42:00 : Variant/Date
- Application.OnTime TimeTxt, "統計" ' 每一分鐘自動再次執行一次。
- End Sub
- Sub dicStatics()
- Dim txt As String, dic As Object, dic2 As Object, A As Range, sp As Variant
- ' txt = [B2] & Left(CStr(Format([A2], "HH:MM:SS")), 5)
- ' txt = [B2] & Left(CStr([A2]), 5)
- ' MsgBox txt
- Set dic = CreateObject("Scripting.Dictionary")
- Set dic2 = CreateObject("Scripting.Dictionary")
- For Each A In Range([A3], [A3].End(xlDown))
- txt = A.Offset(, 1) & "," & Left(Format(A, "HH:MM:SS"), 5)
- ' dic(txt) = IIf(IsEmpty(dic(txt)), A.Offset(, 4).Value + 1, dic(txt)) + A.Offset(, 4).Value
- ' 在 IsEmpty(dic(txt)) 判斷時， dic(txt) 會自動先賦予一次之 A.Offset(, 4).Value 值，然後再次
- ' Assign 一次的 A.Offset(, 4).Value 值， 如 A.Offset(, 4).Value = -1，則結果會變成 -2。
- ' 是故改成如下方式，直接賦予一次之 A.Offset(, 4).Value 值，則結果便會變成 -1 (初始值設定)。
- dic(txt) = dic(txt) + A.Offset(, 4).Value ' 次
- dic2(txt) = dic2(txt) + A.Offset(, 2).Value ' 量
- Next
-
- [M3].Resize(UBound(dic.Keys) + 1) = Application.Transpose(dic.Keys) ' 索引值就是 Keys
- [N3].Resize(UBound(dic.Keys) + 1) = Application.Transpose(dic.Items) ' 資料內容就是 Items
- [O3].Resize(UBound(dic2.Keys) + 1) = Application.Transpose(dic2.Items) ' 資料內容就是 Items
-
- With [M3].Resize(UBound(dic.Keys) + 1, 3) ' Range("M3:M" & [M3].End(xlDown).Row)
- .Cells.Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo ' xlAscending
- End With
-
- For Each A In Range([M3], [M3].End(xlDown))
- sp = Split(A, ",")
- A.Offset(, -1) = sp(0)
- A = sp(1)
- Next
- End Sub
|
|
