查找重复

cui26896

请参考附件

查找重复(cui26890).zip (1.22 MB, 下载次数: 6)

2023-3-30 23:16 上传

点击文件名下载附件

cui26896

1. Sub 简单连接()
   
2. Dim cnn As Object, Rst As Object, RstD As Object, SQL$, SQLD$
   
3. Dim i&
   
4. Set cnn = CreateObject("ADODB.Connection")
   
5. cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes;IMEX=1';Data Source=" & ThisWorkbook.FullName
   
6. SQL = "select 产品 from [Sheet1$] group by 产品 having count(产品)>1"
   
7. SQL = "select a.* from [Sheet1$]a where a.产品 in(" & SQL & ") order by a.产品"
   
8. Set Rst = cnn.Execute(SQL)
   
9. With Worksheets("Sheet2")
   
10.   .UsedRange.ClearContents
    
11.   For i = 0 To Rst.Fields.Count - 1
    
12.     .Cells(1, i + 1) = Rst.Fields(i).Name
    
13.   Next
    
14.   .Range("a2").CopyFromRecordset Rst
    
15.   .Range("A2:C2").Columns.AutoFit
    
16. End With
    
17. cnn.Close
    
18. Set cnn = Nothing: Set Rst = Nothing
    
19. End Sub

复制代码

lizhipei78

小乔℡ 发表于 2023-3-30 12:01
.....................压缩格式不对 传不了文件 给您图片吧

这种回帖我最喜欢了，把原表格及代码一起放上来，有时候 不想去下载附件，但楼主又不放图，都不知道他要干什么