[µo°Ý] Excel 2003¦p¦ó³B²z2007ª©¥»ªº RemoveDuplicates ¤ÎConnections.Count

heavenweaver

½Ð°Ý Excel 2003¦p¦ó³B²z2007ª©¥»ªº RemoveDuplicates ¤ÎConnections.Count

1.Excel 2007ª©¥»
ActiveSheet.Range("$G$1:$G$451").RemoveDuplicates Columns:=1, Header:=xlNo

§ï¼gExcel 2003ª©¥»¡A½Ð¨D°ª¤â­×§ï
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
½Ð¨D°ª¤â­×§ï¡C


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ª©¥»
§ï¼gExcel 2003ª©¥»¡A½Ð¨D°ª¤â¨ó§U¡CÁÂÁ¡I

GBKEE

¦^´_ 1# heavenweaver
2003ª© ¬O³o¼Ë¶Ü?

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

½Æ»s¥N½X

heavenweaver

¦^´_ 2# GBKEE
·PÁÂGBKEEª©¥DªºÃö¤ß¡A2003ª©§R°£­«½Æ¸ê®Æªº°Æµ{¦¡§Ú­è­è§ï¦n¡A´ú¸Õ³£OK¤F¡A¥u³ÑConnections.Countªº°ÝÃD¤F¡C

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