- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 102
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-4-28
               
|
本帖最後由 Hsieh 於 2010-5-9 21:50 編輯
你自己沒嚐試去改改看嗎?
了解整體流程語法的意義後
要修改並不困難
你應該把你修改過程中無法克服的地方拿出來討論
而非要別人直接修好給你
Sub nn()
Dim d As Object, d1 As Object, a As Range, mystr As String
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
t = Timer
With Sheet1
For Each a In .Range(.[A2], .[A65536].End(xlUp))
mystr = Join(Application.Transpose(Application.Transpose(a.Offset(, 1).Resize(, 5))), "")
If IsEmpty(d(mystr)) Then
Ar = a.Offset(, 1).Resize(, 5).Value
d(mystr) = a.Offset(, 1).Resize(, 5).Value
d1(mystr) = 1
Else
Ar = d(mystr)
Ar(1, 5) = Ar(1, 5) + Val(a.Offset(, 5))
d1(mystr) = d1(mystr) + 1
End If
Next
End With
With Sheet2
.[A2:F65536] = ""
.[A2].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.items))
.[F2].Resize(d.Count, 1) = Application.Transpose(d1.items)
End With
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub |
|
發表於 2010-5-7 08:31
| 