【已解决】请问怎么用字典取两列不重复的值

LMY123

求助用字典实现以下代码的功能
Sub 不重复()

     Dim cnn, SQL$
      Set cnn = CreateObject("adodb.connection")
      cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
      SQL = "select 姓,名 from [Sheet1$]  GROUP BY 姓,名 "

      Range("A1:A65536").ClearContents       '清理保存数据的区域
      Range("A1").CopyFromRecordset cnn.Execute(SQL)
      cnn.Close
      Set cnn = Nothing
End Sub



两列组合成两列取不重复值.rar (10.04 KB, 下载次数: 184)

2013-2-15 21:33 上传

点击文件名下载附件

glchenjin

1. Sub 不重复()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Sheets("不重复").Range("A1:b" & [a65536].End(xlUp).Row).ClearContents
   
4.     arr = Sheets("sheet1").Range("a2:b" & [a65536].End(xlUp).Row)
   
5.     For i = 1 To UBound(arr)
   
6.         d(arr(i, 1) & "," & arr(i, 2)) = ""
   
7.     Next
   
8.     Sheets("不重复").Range("A1").Resize(d.Count) = Application.Transpose(d.keys)
   
9.     Sheets("不重复").Range("A1:a" & d.Count).TextToColumns Destination:=Range("A1"), Other:=True, OtherChar:=","
   
10. End Sub
    

复制代码

LMY123

glchenjin 发表于 2013-2-15 21:54

感谢帮助，不太会用，不知为何出现这种情况

zhaogang1960

直接写到数组中，速度快又好理解：

1. Sub Macro1()
   
2.     Dim arr, i&, m&, s$, d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("Sheet1").[a1].CurrentRegion
   
5.     m = 1 '保留标题行
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 1) & Chr(9) & arr(i, 2)
   
8.         If Not d.Exists(s) Then
   
9.             m = m + 1
   
10.             d(s) = ""
    
11.             arr(m, 1) = arr(i, 1)
    
12.             arr(m, 2) = arr(i, 2)
    
13.         End If
    
14.     Next
    
15.     With Sheets("不重复")
    
16.         .Cells.ClearContents
    
17.         .Range("A1").Resize(m, 2) = arr
    
18.     End With
    
19. End Sub
    

复制代码

glchenjin

LMY123 发表于 2013-2-15 21:59
感谢帮助，不太会用，不知为何出现这种情况

1. Sub 不重复()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Sheets("不重复").Range("A1:b" & [a65536].End(xlUp).Row).ClearContents
   
4.     arr = Sheets("Sheet1").Range("a1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         d(arr(i, 1) & "," & arr(i, 2)) = ""
   
7.     Next
   
8.     Sheets("不重复").Range("A1").Resize(d.Count) = Application.Transpose(d.keys)
   
9.     Sheets("不重复").Range("A1:a" & d.Count).TextToColumns Destination:=Range("A1"), Other:=True, OtherChar:=","
   
10. End Sub
    

复制代码

LMY123

zhaogang1960 发表于 2013-2-15 22:09
直接写到数组中，速度快又好理解：

非常感谢版主的指导，效果非常好

LMY123

glchenjin 发表于 2013-2-15 22:13

非常感谢大师的指导，完全符合我的要求

zyg365

glchenjin 发表于 2013-2-15 21:54

达不到要求啊

LMY123

zhaogang1960 发表于 2013-2-15 22:09
直接写到数组中，速度快又好理解：

确实非常好理解代码的含义，只是有一句不明白
s = arr(i, 1) & Chr(9) & arr(i, 2)这一句我改成
s = arr(i, 1)  & arr(i, 2)结果也一样
请问这个Chr(9)有什么作用？

zhaogang1960

LMY123 发表于 2013-2-15 22:35
确实非常好理解代码的含义，只是有一句不明白
s = arr(i, 1) & Chr(9) & arr(i, 2)这一句我改成
s = ar ...

Chr(9)是制表符，作为分隔符，你可以使用别的不太常用的字符
s = arr(i, 1)  & arr(i, 2)可能有危险：
"雷锋塔" & "身"="雷锋" & "塔身"="雷锋塔身"