- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 13# missbb
字典物件,也可試試看.- Option Explicit
- Sub Ex()
- Dim xDATE As Range, i, Rng As Range
- Dim D As Object, K, X As Long, Ar As Variant
- Set xDATE = Sheets("Attendance Report").[J3] '輸入報表首日之前1日日期 的儲存格
- With Sheets("data") '資料工作表
- Set Rng = .[D4] '資料開使的儲存格
- X = 0
- Do While Rng <> ""
- Set D = CreateObject("SCRIPTING.DICTIONARY") '設立變數 :字典物件
- i = 1
- Do While Rng.Offset(i - 1) = Rng 'Employee 上下列相同
- With Rng.Offset(i - 1)
- If D.EXISTS(.Range("C1").Value) Then '如果在 Dictionary 物件中指定的關鍵字存在，傳回 True，
- D(.Range("C1").Value) = D(.Range("C1").Value) & "," & .Range("D1").Text
- Else
- D(.Range("C1").Value) = .Range("D1").Text
- '.Range("C1").Value 為日期值
- End If
- End With
- i = i + 1
- Loop
- For Each K In D.KEYS 'Keys 方法 傳回一個陣列，該陣列包含一個 Dictionary 物件中的全部既存的的關鍵字。
- Ar = Split(D(K), ",") 'Keys的內容
- With xDATE.Offset(, K - xDATE) 'k 為日期值
- .Parent.Cells(.Row + X + 1, "a") = Rng.Range("b1").Value
- .Parent.Cells(.Row + X + 1, "d").Resize(20) = Rng
- If UBound(Ar) = 1 Then
- .Cells(X + 3) = Ar(0)
- .Cells(X + 4) = Ar(1)
- ElseIf UBound(Ar) = 2 Then
- .Cells(X + 3) = Ar(0)
- .Cells(X + 4) = Ar(2)
- .Cells(X + 10) = Ar(1)
- ElseIf UBound(Ar) = 3 Then
- .Cells(X + 3) = Ar(0)
- .Cells(X + 4) = Ar(3)
- .Cells(X + 10) = Ar(1)
- .Cells(X + 11) = Ar(2)
- ElseIf UBound(Ar) = 4 Then
- .Cells(X + 3) = Ar(0)
- .Cells(X + 4) = Ar(4)
- .Cells(X + 10) = Ar(1)
- .Cells(X + 11) = Ar(2)
- End If
- End With
- Next
- X = X + 20
- Set Rng = Rng.Offset(i)
- Loop
- End With
- End Sub
|
|
發表於 2015-8-16 17:05
| 