返回列表 上一主題 發帖

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

[發問] 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版本,請求高手協助。謝謝!
很抱歉,我是小學生,不能下載檔案,是個小屁孩!

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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
很抱歉,我是小學生,不能下載檔案,是個小屁孩!

TOP

        靜思自在 : 自己害自己,莫過於亂發脾氣。
返回列表 上一主題