对比差异差异（数据量超过1百万行）

lg747699 · 发表于 2024-7-2 10:39

魂断蓝桥发表于 2024-7-2 10:30
超过100万的话，用sqlite更好一些，你得excel是32位还是64位，如果32位可用vbRichClient5

老师，我的是64 位操作系统, 基于 x64 的处理器

lg747699 · 发表于 2024-7-2 12:37

魂断蓝桥发表于 2024-7-2 09:07
Option Explicit
Sub a()
Dim cat, strconn As String, tb1, tb2

老师，为什么我参考，把Microsoft.Jet.OLEDB.4.0
改成Microsoft.ACE.OLEDB.12.
没结果出来呢？

魂断蓝桥 · 发表于 2024-7-2 13:04

lg747699 发表于 2024-7-2 10:39
老师，我的是64 位操作系统, 基于 x64 的处理器

我的是64 位操作系统, 基于 x64 的处理器

我问的是【excel是32位还是64位】

魂断蓝桥 · 发表于 2024-7-2 13:10

lg747699 发表于 2024-7-2 12:37
老师，为什么我参考，把Microsoft.Jet.OLEDB.4.0
改成Microsoft.ACE.OLEDB.12.
没结果出来呢？

我这里测试没有问题

Option Explicit
Sub a()
Dim cat, strconn As String, tb1, tb2
Dim myf As String
Application.ScreenUpdating = False
myf = ThisWorkbook.Path & "\a.mdb"
If Dir(myf) <> "" Then Kill myf
Set cat = CreateObject("adox.catalog")
strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myf
cat.Create strconn
Set tb1 = CreateObject("ADOX.Table")
Set tb2 = CreateObject("ADOX.Table")
With tb1
      .ParentCatalog = cat
      .Name = "T1"
      .Columns.Append "ID", 3
      .Columns("ID").Properties("AutoIncrement") = True
      .Columns.Append "编号", 202, 50
      .Keys.Append "PrimaryKey", 1, "ID"
      cat.Tables.Append tb1
End With
With tb2
      .ParentCatalog = cat
      .Name = "T2"
      .Columns.Append "ID", 3
      .Columns("ID").Properties("AutoIncrement") = True
      .Columns.Append "编号", 202, 50
      .Keys.Append "PrimaryKey", 1, "ID"
      cat.Tables.Append tb2
End With
Set cat.ActiveConnection = Nothing
Dim myfile As String, wb As Workbook, i&, J&, m&, arr, cnn, sql$
myf = ThisWorkbook.Path & "\"
myfile = Dir(myf & "*订单*.xls*")
Set cnn = CreateObject("ADODB.CONNECTION")
cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\a.mdb"
Do While myfile <> ""
      If myfile <> ThisWorkbook.Name Then
         Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & myfile)
         If wb.Sheets.Count > 1 Then
            For i = 1 To wb.Sheets.Count
                  arr = wb.Sheets(i).[A1].CurrentRegion
                  For J = 1 To 5 Step 4
                     For m = 1 To UBound(arr)
                        sql = "INSERT INTO T2(编号) VALUES('" & arr(m, J) & "')"
                        cnn.Execute sql
                     Next
                  Next
            Next
         Else
            arr = wb.Sheets(1).[A1].CurrentRegion
            For m = 2 To UBound(arr)
                  sql = "INSERT INTO T1(编号) VALUES('" & arr(m, 1) & "')"
                  cnn.Execute sql
            Next
         End If
         wb.Close 0
      End If
      myfile = Dir
Loop
With Sheet2
      .Cells.Clear
      .[A1] = "ERP有但SRM找不到"
      .[D1] = "SRM有但ERP查不到"
      sql = "select 编号 FROM T1 WHERE 编号 NOT IN (SELECT 编号 from T2)"
      .Range("B2").CopyFromRecordset cnn.Execute(sql)
      sql = "select 编号 FROM T2 WHERE 编号 NOT IN (SELECT 编号 from T1)"
      .Range("E2").CopyFromRecordset cnn.Execute(sql)
End With
Set cnn = Nothing
   Application.ScreenUpdating = True
End Sub

边缘码农 · 发表于 2024-7-2 13:25

lg747699 发表于 2024-7-2 12:37
老师，为什么我参考，把Microsoft.Jet.OLEDB.4.0
改成Microsoft.ACE.OLEDB.12.
没结果出来呢？

Sub 提取()
Dim wb As Workbook
Dim ws As Worksheet
Dim cellValue As Variant
Dim filePath As String
Dim MaxRow As Long
Dim NameList As String
Dim NameArr() As String
Dim I As Long, J As Long, X As Long
Dim dict As Object
Dim dict2 As Object
Dim dict3 As Object
Dim TitleList As String
On Error Resume Next
Application.ScreenUpdating = False ' 关闭屏幕更新
' 创建新的字典
Set dict = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
Set dict3 = CreateObject("Scripting.Dictionary")
NameList = "erp订单1.xlsx，erp订单2.xlsx" ' 工作簿名称列表
TitleList = "A，E"
NameArr = Split(NameList, "，")
For I = 0 To UBound(NameArr)
filePath = ThisWorkbook.Path & "" & NameArr(I)
Set wb = Workbooks.Open(filePath) ' 打开工作簿
Set ws = wb.Sheets(1) ' 第一个工作表
' 读取内容
With ws
MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row '第1列最后一行
DateArr = .Range(.Cells(2, 1), .Cells(MaxRow, 1)).Value '默认第1行是标题行
End With
wb.Close SaveChanges:=False ' 关闭工作簿，不保存更改
For J = 1 To UBound(DateArr)
ff = UBound(DateArr)
If Err.Number = 0 Then
dict.Add DateArr(J, 1), DateArr(J, 1)
Else
dict.Add DateArr, DateArr
End If
Err.Clear
Next J
DoEvents
Next I
' 读取SRM
filePath = ThisWorkbook.Path & "\srm订单.xls"
Set wb = Workbooks.Open(filePath) ' 打开工作簿
NameArr = Split(TitleList, "，")
Set wb = Workbooks.Open(filePath) ' 打开工作簿
For I = 1 To wb.Sheets.Count
Set ws = wb.Sheets(I) ' 第I个工作表
For J = 0 To UBound(NameArr)
' 读取内容
With ws
MaxRow = .Cells(.Rows.Count, NameArr(J)).End(xlUp).Row '第J列最后一行
DateArr = .Range(.Cells(1, NameArr(J)), .Cells(MaxRow, NameArr(J))).Value
End With
For X = 1 To UBound(DateArr)
ff = UBound(DateArr)
If Err.Number = 0 Then
dict2.Add DateArr(X, 1), DateArr(X, 1)
Else
dict2.Add DateArr, DateArr
End If
Err.Clear
Next X
Next J
DoEvents
Next I
wb.Close SaveChanges:=False ' 关闭工作簿，不保存更改
' 清除对象变量
Set ws = Nothing
Set wb = Nothing
' 开始进行判断
' srm有但erp找不到，E列数据
For Each key1 In dict2.keys
If Not dict.Exists(key1) Then
dict3.Add key1, key1
End If
DoEvents
Next
With Sheet1
.Cells(15, "E").Resize(dict3.Count, 1) = WorksheetFunction.Transpose(dict3.keys)
End With
dict3.RemoveAll
' ERP有但SR找不到，E列数据
For Each key1 In dict.keys
If Not dict2.Exists(key1) Then
dict3.Add key1, key1
End If
DoEvents
Next
With Sheet1
.Cells(15, "B").Resize(dict3.Count, 1) = WorksheetFunction.Transpose(dict3.keys)
End With
Set dict = Nothing
Set dict2 = Nothing
Set dict3 = Nothing
Application.ScreenUpdating = True ' 开启屏幕更新
End Sub

复制代码

使用了3个字典，不知道大数据量下会占用多少时间。

lg747699 · 发表于 2024-7-2 13:35

魂断蓝桥发表于 2024-7-2 13:04
我的是64 位操作系统, 基于 x64 的处理器

我问的是【excel是32位还是64位】

Microsoft® Excel® 2019MSO (版本 2406 Build 16.0.17726.20078) 64 位

lg747699 · 发表于 2024-7-2 14:03

魂断蓝桥发表于 2024-7-2 13:04
我的是64 位操作系统, 基于 x64 的处理器

我问的是【excel是32位还是64位】

我的是64位EXCEL。确定看了EXCEL账号提示。

魂断蓝桥 · 发表于 2024-7-2 14:08

lg747699 发表于 2024-7-2 14:03
我的是64位EXCEL。确定看了EXCEL账号提示。

那用不了vbRichClient5

413254881 · 发表于 2024-7-2 14:08

可以发下源数据么我想测试下速度

魂断蓝桥 · 发表于 2024-7-2 14:09

lg747699 发表于 2024-7-2 12:37
老师，为什么我参考，把Microsoft.Jet.OLEDB.4.0
改成Microsoft.ACE.OLEDB.12.
没结果出来呢？

我试了一下，我这里好用

		自动登录	找回密码
密码			免费注册

[求助] 对比差异差异（数据量超过1百万行）