- 帖子
- 227
- 主題
- 3
- 精華
- 1
- 積分
- 273
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- XP
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2011-3-22
- 最後登錄
- 2013-1-29
|
請問該如何寫巨集呢?
我點選複製代碼貼上後得到以下答案
下載 (37.34 KB)
2 小時前
dragonbx 發表於 2011-5-6 17:25  - Private Sub CommandButton1_Click()
- Dim d As Object, d2 As Object, a, arr, i&, m&, r&
- Set d = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- a = Range([a2], [b65536].End(3))
- ReDim arr(1 To UBound(a), 1 To 250)
- For i = 1 To UBound(a)
- If d(a(i, 1)) = "" Then
- m = m + 1
- d(a(i, 1)) = m
- d2(a(i, 1)) = 2
- arr(1, d(a(i, 1))) = a(i, 1): arr(2, d(a(i, 1))) = a(i, 2)
- Else
- d2(a(i, 1)) = d2(a(i, 1)) + 1
- arr(d2(a(i, 1)), d(a(i, 1))) = a(i, 2)
- r = IIf(r > d2(a(i, 1)), r, d2(a(i, 1)))
- End If
- Next
- [e:iv] = ""
- [f1].Resize(r, m) = arr
- ReDim arr(1 To r, 0)
- For i = 1 To r - 1
- arr(i, 0) = [b1] & i
- Next
- [e2].Resize(r - 1, 1) = arr
- End Sub
|
|
發表於 2011-5-6 12:54
| 
