chrisovo的部落格

問題：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