標題: [發問] Excel 2003如何處理2007版本的 RemoveDuplicates 及Connections.Count [打印本頁]

---

作者: heavenweaver    時間: 2014-2-28 22:30     標題: Excel 2003如何處理2007版本的 RemoveDuplicates 及Connections.Count

本帖最後由 heavenweaver 於 2014-2-28 22:31 編輯

請問 Excel 2003如何處理2007版本的 RemoveDuplicates 及Connections.Count

1.Excel 2007版本
ActiveSheet.Range("$G$1:$G$451").RemoveDuplicates Columns:=1, Header:=xlNo

改寫Excel 2003版本，請求高手修改
Dim rng As Range, n As Long, tmpa()
ReDim tmpa(1 To 100, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For Each rng In ActiveSheet.Range("$G$1:$G$100")
        n = 0
        If Not .Exists(rng.Value) Then
            n = n + 1
            tmpa(n, 1) = rng.Value
            .Item(rng.Value) = Empty
        End If
    Next
End With
ActiveSheet.Range("$G$1:$G$100").Value = tmpa
請求高手修改。


2.Excel 2007版本
If ActiveWorkbook.Connections.Count > 0 Then
        For i = 1 To ActiveWorkbook.Connections.Count
            ActiveWorkbook.Connections.Item(1).Delete
        Next i
End If

Excel 2003版本
改寫Excel 2003版本，請求高手協助。謝謝！

---

作者: GBKEE    時間: 2014-3-1 14:32

回復 1# heavenweaver
2003版 是這樣嗎?

1. Option Explicit
   
2. Sub EX()
   
3.     Dim rng As Range, n As Long, tmpa()
   
4.     ReDim tmpa(1 To 100, 1 To 1)
   
5.     With CreateObject("Scripting.Dictionary")
   
6.         .CompareMode = 1
   
7.         n = 0
   
8.         For Each rng In ActiveSheet.Range("$G$1:$G$100")
   
9.             If Not .Exists(rng.Value) Then
   
10.                 n = n + 1
    
11.                 tmpa(n, 1) = rng.Value
    
12.                 .Item(rng.Value) = Empty
    
13.             End If
    
14.         Next
    
15.     End With
    
16.     ActiveSheet.Range("$G$1:$G$100").Value = tmpa
    
17. End Sub

複製代碼

---

作者: heavenweaver    時間: 2014-3-1 15:33

回復 2# GBKEE
感謝GBKEE版主的關心，2003版刪除重複資料的副程式我剛剛改好，測試都OK了，只剩Connections.Count的問題了。

Sub removedub(rng As String)

Dim r As Range, n As Long, a()
'lr2 = Range("A" & Rows.Count).End(xlUp).Row    ' define lr2 as the last row of data
'MsgBox ("Row Number = ") & Right(rng, Len(rng) - 3)
lr2 = Range(Right(rng, Len(rng) - 3)).Row
'MsgBox ("Row Number = ") & lr2
ReDim a(1 To lr2 - 1, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For Each r In ActiveSheet.Range(rng)
        If Not .Exists(r.Value) Then
            n = n + 1
            a(n, 1) = r.Value
            .Item(r.Value) = Empty
        End If
    Next
End With
ActiveSheet.Range(rng).Value = a
End Sub

Sub Test()

Dim r1 As String
r1 = "A2:A6"
removedub (r1)
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)