百万条数据,提取唯一值

hellikawhi2

lsdongjh 发表于 2021-9-14 14:00
SQL解决：

新手不懂sql,不知道怎么加到vba

于箱长

hellikawhi2 发表于 2021-9-14 14:12
dic(arr(i,j))=arr(i,j)还是会出现自动化automation错误

https://club.excelhome.net/forum ... read&tid=907145

hellikawhi2

于箱长 发表于 2021-9-14 14:16
https://club.excelhome.net/forum.php?mod=viewthread&tid=907145

刚才运行了win+r,然后打开vba,一直在运行中,等了两分钟了,

于箱长

hellikawhi2 发表于 2021-9-14 14:24
刚才运行了win+r,然后打开vba,一直在运行中,等了两分钟了,

敢不敢把数据发上来，我测试一下

hellikawhi2

于箱长 发表于 2021-9-14 14:26
敢不敢把数据发上来，我测试一下

一个工作簿,9m,超过大小限制了,上传文件只能小与2m

于箱长

hellikawhi2 发表于 2021-9-14 14:31
一个工作簿,9m,超过大小限制了,上传文件只能小与2m

分卷压缩呀

lsdongjh

hellikawhi2 发表于 2021-9-14 14:14
新手不懂sql,不知道怎么加到vba

lsdongjh

1. Sub GetValue()
   
2.     Dim sh As Worksheet, strShName As String, lngRows As Long
   
3.     Dim Conn As Object, Rst As Object, strPath As String
   
4.     Dim strConn As String, strSQL As String, strTable As String
   
5.     Dim rg As Range
   
6.    
   
7.     strShName = "Sheet1"
   
8.     Set sh = Sheets(strShName)
   
9.     lngRows = sh.UsedRange.Rows.Count
   
10.     strTable = "[" & strShName & "$A1:D" & lngRows & "]"
    
11.     Set rg = sh.Range("K1") '结果填充起始单元格
    
12.     sh.UsedRange.NumberFormatLocal = "@" '**运行前，将工作表的单元格式 设置为【文本】
    
13.    
    
14.     Set Conn = CreateObject("ADODB.Connection")
    
15.     Set Rst = CreateObject("ADODB.Recordset")
    
16.     strPath = ThisWorkbook.FullName
    
17.     Select Case Application.Version * 1
    
18.         Case Is <= 11
    
19.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
    
20.         Case Is >= 12
    
21.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
22.     End Select
    
23.     Conn.Open strConn
    
24.     strSQL = "(SELECT 数据1 AS F1 FROM " & strTable & " WHERE 数据1 NOT IN (SELECT 数据3 FROM " & strTable & ")) UNION " & _
    
25.              "(SELECT 数据2 AS F1 FROM " & strTable & " WHERE 数据2 NOT IN (SELECT 数据3 FROM " & strTable & "))"
    
26.     Rst.Open strSQL, Conn, 3, 1
    
27.     rg.CopyFromRecordset Rst
    
28.    
    
29.     MsgBox "提取不重复记录 " & Rst.RecordCount & " 条"
    
30.     If Rst.State = 1 Then Rst.Close
    
31.     If Conn.State = 1 Then Conn.Close
    
32.     Set Rst = Nothing
    
33.     Set Conn = Nothing
    
34.    
    
35.     Set rg = Nothing
    
36.     Set sh = Nothing
    
37. End Sub

复制代码

hellikawhi2

于箱长 发表于 2021-9-14 14:32
分卷压缩呀

测试测试测试测试测试测试测试测试测试测试

于箱长

hellikawhi2 发表于 2021-9-14 14:38
测试测试测试测试测试测试测试测试测试测试

确实挺卡地