問題:http://club.excelhome.net/thread-1397708-1-1.html
主要解法:
union
解法:
Sub test2()
Dim d, arr
Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
n = UBound(arr, 1): m = UBound(arr, 2)
'這邊迴圈將同一個年級的資料用Union的方式匯總起來
'這邊在寫入字典時是用 Set d() = range().resize(),應是因為range.resize的結果係物件的緣故
'故無法直接用d(keys) = d(items),而要用Set將range.resize的物件賦予給變數 d()
'之後再搭配union,將所有該年級的資訊全部賦予給d(keys)
For i = 2 To n
If arr(i, 2) <> "" Then
If Not d.exists(arr(i, 2)) Then
Set d(arr(i, 2)) = Range("a" & i).Resize(1, m)
Else
Set d(arr(i, 2)) = Union(d(arr(i, 2)), Range("a" & i).Resize(1, m))
End If
End If
Next
'將keys的賦予一維數列h
h = d.keys
'當d為物件變數時,可以直接用d(keys).copy的方式將裡面物件複製
'(此例另外一個人的寫法是 d.items()(k).Copy sht.[a2] )
'補充:嘗試另外一種寫法
Qitem = d(h(k)) : [a2].resize(ubound(qitem,1),ubound(qitem,2)) = application.transpose(application.transpose(qitem))[此寫法請參考工資計提表模板]
僅會帶出第一個資料,應是因為此時的d是物件變量,因此在將d(h(k))值賦予給qitem變數時無法將數值順利傳出。
For k = 0 To UBound(h)
d(h(k)).Copy Worksheets(h(k) & "年級").[a2]
Next
End Sub
留言列表