- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 102
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-4-28
               
|
9#
發表於 2010-9-13 11:23
| 只看該作者
- Sub nn()
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- With Sheets("編號")
- For Each a In .Range(.[A2], .[A65536].End(xlUp))
- d(a.Value) = d(a.Value) + a.Offset(, 7)
- d1(a.Value) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, Mid(a.Offset(, 3), 1, 11), a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value)
- Next
- Sheets("Sheet1").[A2:G65536].Clear
- For Each ky In d.keys
- ReDim Ar(d(ky))
- For i = 0 To d(ky) - 1
- x = d1(ky)(3) & Format(i, "0000000")
- With Sheets("Sheet1")
- .[A65536].End(xlUp).Offset(1, 0).Resize(, 7) = Array(d1(ky)(0), d1(ky)(1), d1(ky)(2), x, d1(ky)(4), d1(ky)(5), d1(ky)(6))
- End With
- Next
- Next
- End With
- End Sub
複製代碼 |
|