- 帖子
- 163
- 主題
- 1
- 精華
- 0
- 積分
- 170
- 點名
- 0
- 作業系統
- Window 7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-9-5
- 最後登錄
- 2022-7-20
|
4#
發表於 2017-2-14 09:53
| 只看該作者
回復 1# Changbanana
用了一個Dictionary物件，看看執行速度是否能提升？- Sub test()
- Dim d As Object
- Set d = CreateObject("Scripting.Dictionary")
- Dim arr, brr()
- With Sheets("工作表2")
- er = .[A65536].End(3).Row
- arr = .Range("A2:B" & er)
- End With
- For i = 1 To UBound(arr)
- If d.exists(arr(i, 2)) Then
- d(arr(i, 2)) = "↑"
- Else
- d(arr(i, 2)) = "'" & arr(i, 1)
- End If
- Next i
- With Sheets("工作表1")
- .Range("G2:G65536").ClearContents
- er = .[A65536].End(3).Row
- arr = .Range("A2:B" & er)
- End With
- For i = 1 To UBound(arr)
- If d.exists(arr(i, 1)) Then
- If d(arr(i, 1)) = "↑" Then
- arr(i, 2) = ""
- n = n + 1
- ReDim Preserve brr(1 To n)
- brr(n) = arr(i, 1)
- Else
- arr(i, 2) = d(arr(i, 1))
- End If
- Else
- arr(i, 2) = ""
- End If
- Next i
- Sheets("工作表1").[A2].Resize(UBound(arr), 2) = arr
- Sheets("工作表1").[G2].Resize(UBound(brr), 1) = Application.Transpose(brr)
- Set d = Nothing
- arr = ""
- Erase brr
- End Sub
|
|
