- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 133
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-6-1
               
|
回復 11# loyyee
並非資料筆數問題
是如果沒有和條件的資料就會造成Resize出錯- Sub Ex()
- Dim Ay(), Ay1()
- Set d = CreateObject("Scripting.dictionary")
- Set d1 = CreateObject("Scripting.dictionary")
- [E6].CurrentRegion.Offset(1, 0) = ""
- [I1].CurrentRegion.Offset(1, 0) = ""
- ar1 = [A1].CurrentRegion.Columns(1).Value
- ar2 = [A1].CurrentRegion.Columns(2).Value
- ar = Array(ar1, ar2)
- For i = 0 To 1
- For Each a In ar(i)
- Select Case i
- Case 0
- If a <> "" Then d(a) = d(a) + 1
- Case 1
- If a <> "" Then d1(a) = d1(a) + 1
- End Select
- Next
- Next
- dic = Array(d, d1)
- For i = 0 To 1
- For Each ky In dic(i).keys
- p = IIf(i = 0, 1, 0)
- If dic(p).exists(ky) = False Then
- ReDim Preserve Ay(s)
- Ay(s) = ky
- s = s + 1
- End If
- If dic(i)(ky) > 1 Then
- ReDim Preserve Ay1(k)
- Ay1(k) = ky
- k = k + 1
- End If
- Next
- If s > 0 Then Cells(2, 9 + i).Resize(s, 1) = Application.Transpose(Ay): s = 0: Erase Ay
- If k > 0 Then Cells(7, 5 + i).Resize(k, 1) = Application.Transpose(Ay1): k = 0: Erase Ay1
- Next
- End Sub
|
|
發表於 2011-10-9 19:09
| 