如何用VBA数组+字典，将二个工作表的相同内容的对齐，放在同一行？

VBA之恋

如何用VBA数组+字典，将二个工作表的相同内容的单据，（N个条件一样）（例子中，是六个条件一样。供应单位对核算项目，开票日期对日期，发票号码对单据号，物料名称对物号名称，数量对数量，金额对单据金额），对齐放在同一行？例子中的数据源很少，实际中有上百万行，列数和行数的不固定的。
谢谢大家！
如何让相同数据自动对齐.rar (23.63 KB, 下载次数: 32)

2017-6-12 06:48 上传

点击文件名下载附件

VBA之恋

希望能得到高人的的帮助，谢谢！

zax010

Sub zz()
    Dim d(1 To 3) As New Dictionary, ar, br
    ar = Sheet1.Range("A1").CurrentRegion
    br = Sheet3.Range("A1").CurrentRegion
    Application.ScreenUpdating = False
    For i = 2 To UBound(ar)
        s = "(" & ar(i, 1) & ")" & ar(i, 2) & ar(i, 3) & ar(i, 4) & ar(i, 7) & ar(i, 8)
        d(1)(s) = i: d(3)("(" & ar(i, 1) & ")") = ""
    Next
    For i = 2 To UBound(br)
        s = "(" & br(i, 1) & ")" & br(i, 2) & br(i, 3) & br(i, 4) & br(i, 5) & br(i, 9)
        d(2)(s) = i: d(3)("(" & br(i, 1) & ")") = ""
    Next
    For Each k In d(3).Keys
        a = Filter(d(1).Keys, k)
        For i = 0 To UBound(a)
            Cells(2 + n, 1).Resize(1, 8) = Application.Index(ar, d(1)(a(i)))
            If d(2).Exists(a(i)) Then
                Cells(2 + n, 9).Resize(1, 9) = Application.Index(br, d(2)(a(i)))
                d(2).Remove a(i)
            End If
            n = n + 1
        Next
        b = Filter(d(2).Keys, k)
        For i = 0 To UBound(b)
            Cells(2 + n, 9).Resize(1, 9) = Application.Index(br, d(2)(b(i)))
            n = n + 1
        Next
    Next
    Application.ScreenUpdating = True
End Sub

zax010

又是审核！

1、如果数据上百w行，这个代码无能为力，仅给予参考；

2、结果没排序，这种排序我也不会。


如何让相同数据自动对齐.rar (28.14 KB, 下载次数: 64)

2017-6-18 13:26 上传

点击文件名下载附件

jiminyanyan

zax010 发表于 2017-6-18 13:26
又是审核！

1、如果数据上百w行，这个代码无能为力，仅给予参考；

我就发一句话也审核，应提个建议，优秀会员（或什么级别以上）就不要审核了吧…………

LMY123

支持，侠圣级别的应该直接过

marchwen01

直接用SQL语句来做。不知道上百万行的数据能不能搞定。就等楼主你来测试了，测试结果过来说一下，哈哈。。

1. Option Explicit
   
2. 
   
3. '定义 连接对象 和 记录集对象
   
4. Public cnn As Object
   
5. Public rst As Object
   
6. 
   
7. '数据连接 函数
   
8. Function cnnOpen()
   
9.     With cnn
   
10.         If .State = 0 Then
    
11.             .Provider = "Microsoft.Jet.Oledb.4.0;Extended Properties = Excel 8.0"
    
12.             .ConnectionString = ThisWorkbook.FullName
    
13.             .Open
    
14.         End If
    
15.     End With
    
16. End Function
    
17. 
    
18. Sub Main()
    
19.     Dim i As Integer
    
20.     Dim sql As String
    
21.    
    
22.     '创建 连接对象 和 记录集对象
    
23.     Set cnn = CreateObject("ADODB.Connection")
    
24.     Set rst = CreateObject("ADODB.Recordset")
    
25.    
    
26.     '编写 SQL 语句（全外连接）
    
27.     sql = "SELECT * FROM [比较表一$] t1 LEFT JOIN [比较表二$] t2 ON " _
    
28.         & "t1.开票日期=t2.日期 AND t1.发票号码=t2.单据号 AND t1.物料名称=t2.物号名称 AND t1.数量=t2.数量 AND t1.数量=t2.数量 " _
    
29.         & "UNION " _
    
30.         & "SELECT * FROM [比较表一$] t1 RIGHT JOIN [比较表二$] t2 ON " _
    
31.         & "t1.开票日期=t2.日期 AND t1.发票号码=t2.单据号 AND t1.物料名称=t2.物号名称 AND t1.数量=t2.数量 AND t1.数量=t2.数量" _
    
32. 
    
33.     cnnOpen '打开数据连接
    
34.    
    
35.     Set rst = cnn.Execute(sql)  '执行 SQL 语句，结果赋值给 记录集对象
    
36.    
    
37.     With Worksheets("代码运行落点")
    
38.         .Range("A2").CopyFromRecordset rst  '输出记录集到工作表，从 A2 单元格开始
    
39.         
    
40.         '输出 记录集 的字段名
    
41.         For i = 0 To rst.Fields.Count - 1
    
42.             .Cells(1, i + 1).Value = rst.Fields(i).Name
    
43.         Next
    
44.     End With
    
45.    
    
46.     '释放内存
    
47.     rst.Close
    
48.     Set rst = Nothing
    
49.     cnn.Close
    
50.     Set cnn = Nothing
    
51. End Sub
    

复制代码

marchwen01

用 ADODB 没试过上百万行数据的，楼主请来告诉我测试结果。

1. Option Explicit
   
2. 
   
3. '定义 连接对象 和 记录集对象
   
4. Public cnn As Object
   
5. Public rst As Object
   
6. 
   
7. '数据连接 函数
   
8. Function cnnOpen()
   
9.     With cnn
   
10.         If .State = 0 Then
    
11.             .Provider = "Microsoft.Jet.Oledb.4.0;Extended Properties = Excel 8.0"
    
12.             .ConnectionString = ThisWorkbook.FullName
    
13.             .Open
    
14.         End If
    
15.     End With
    
16. End Function
    
17. 
    
18. Sub Main()
    
19.     Dim i As Integer
    
20.     Dim sql As String
    
21.    
    
22.     '创建 连接对象 和 记录集对象
    
23.     Set cnn = CreateObject("ADODB.Connection")
    
24.     Set rst = CreateObject("ADODB.Recordset")
    
25.    
    
26.     '编写 SQL 语句（全外连接）
    
27.     sql = "SELECT * FROM [比较表一$] t1 LEFT JOIN [比较表二$] t2 ON " _
    
28.         & "t1.开票日期=t2.日期 AND t1.发票号码=t2.单据号 AND t1.物料名称=t2.物号名称 AND t1.数量=t2.数量 AND t1.数量=t2.数量 " _
    
29.         & "UNION " _
    
30.         & "SELECT * FROM [比较表一$] t1 RIGHT JOIN [比较表二$] t2 ON " _
    
31.         & "t1.开票日期=t2.日期 AND t1.发票号码=t2.单据号 AND t1.物料名称=t2.物号名称 AND t1.数量=t2.数量 AND t1.数量=t2.数量" _
    
32. 
    
33.     cnnOpen '打开数据连接
    
34.    
    
35.     Set rst = cnn.Execute(sql)  '执行 SQL 语句，结果赋值给 记录集对象
    
36.    
    
37.     With Worksheets("代码运行落点")
    
38.         .Range("A2").CopyFromRecordset rst  '输出记录集到工作表，从 A2 单元格开始
    
39.         
    
40.         '输出 记录集 的字段名
    
41.         For i = 0 To rst.Fields.Count - 1
    
42.             .Cells(1, i + 1).Value = rst.Fields(i).Name
    
43.         Next
    
44.     End With
    
45.    
    
46.     '释放内存
    
47.     rst.Close
    
48.     Set rst = Nothing
    
49.     cnn.Close
    
50.     Set cnn = Nothing
    
51. End Sub
    

复制代码

marchwen01

附件，供参考。。。。。。。

记得来说一下测试结果哦。

VBA之恋

marchwen01 发表于 2017-6-18 15:43
附件，供参考。。。。。。。

记得来说一下测试结果哦。

你好，核算项目和供货单位没有放进去，且语句中，数量重复了二次，我想将其中改为核算项目和供货单位，不知为何，没有成功。