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

VBA之恋

yaozong 发表于 2017-6-23 10:19
在28楼附件的基础上，作了更改，运行速度要快点。

你好，谢谢你的帮助。关健之处，是能处理几十万行或上百万行的数据量，那怕同速度慢些。谢谢！因为其困难度，所以代码有效起作是第一的。

yaozong

VBA之恋 发表于 2017-6-25 12:05
你好，谢谢你的帮助。关健之处，是能处理几十万行或上百万行的数据量，那怕同速度慢些。谢谢！因为其困难 ...

数据量大时，宜用EXCEL自带有排序（赋值后再排序）

参考：

Sub yyzz() ''工作表自带排序（辅助列）
Application.ScreenUpdating = False
Dim d, arr, brr, ar, t
Dim ss$, i&, j&, k&, m&, n&, x&, y&
t = Timer
Set d = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("A1").CurrentRegion.Value ''数据源一
brr = Sheet3.Range("A1").CurrentRegion.Value ''数据源二
ReDim crr(1 To UBound(arr) + UBound(brr), 1 To 18)
For i = 2 To UBound(arr)
  ss = arr(i, 1) & "@" & arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 7) & arr(i, 8)
  If Not d.Exists(ss) Then
    m = m + 1: d(ss) = m
    For j = 1 To 8
      crr(m, j) = arr(i, j)
    Next
    crr(m, 18) = zs(arr(i, 1)) ''中文小写转数值（自定义函数）
  End If
Next
For i = 2 To UBound(brr)
  ss = brr(i, 1) & "@" & brr(i, 2) & brr(i, 3) & brr(i, 4) & brr(i, 5) & brr(i, 9)
  If d.Exists(ss) Then
    For j = 1 To 9
      crr(d(ss), j + 8) = brr(i, j)
    Next
  Else
    m = m + 1
    For j = 1 To 9
      crr(m, j + 8) = brr(i, j)
    Next
     crr(m, 18) = zs(brr(i, 1)) ''中文小写转数值（自定义函数）
  End If
Next
With Sheet4 ''运行结果落地点
  [a2].CurrentRegion.Offset(1).ClearContents
  [a2].Resize(m, 18) = crr
  [a2].Resize(m, 18).Sort [r2], 1
  [r2].Resize(m).ClearContents
End With
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.0000s")
End Sub

yaozong

参考附件    170623-如何让相同数据自动对齐.rar (26.5 KB, 下载次数: 45)

2017-6-25 13:11 上传

点击文件名下载附件

jiminyanyan

作个记号。。。。。看一下答案是什么。。。

VBA之恋

yaozong 发表于 2017-6-25 13:11
参考附件

你好，能用于几十万的数据吗？当初我以为改下变量就行了

yaozong

我还在用2003版，几十万的数据你自已试一下。

jjmysjg

留个记号，谢谢

yzxfelix

yaozong 发表于 2017-6-22 10:03
结合排序，仅供参考。

老师的代码总是精炼，得体

blackttea1

留个记号，谢谢