2个工作表按行循环对比重复数

hzg312

       “数据”表为每行10个数，共有2000行。
       “对比”表为每行18个数，共有500行。
        现将“数据”表的每行和“对比”表的每行逐一进行重复数个数对比，并将对比结果显示在“结果”表。（既“数据”表第一行数据和“对比”表的500行逐一重复对比结束后。重复数个数的值应该有500个结果，重复数的个数范围在0至10之间。统计相同值的结果，并自动填入“结果”表对应的。）
       如“数据”表第一行数据和“对比”表500行数据重复对比完后，重复10个数的有20次，重复8个数的有100次，重复5个数的300次，重复2个数的有50次，重复0个数的有30次。则依次在“结果”表的重复个数列，对应填入20、100、300、50、30.
      我才开始学vba，处理不了这么复杂的循环对比、统计结果、并自动填入的问题。请各位老师帮忙看看能否有办法解决。谢谢各位老师！！！

xiangbaoan

Option Explicit
Sub test()
Dim ar, br, d As Object, i&, j&, k&, x&, y&
Set d = CreateObject("Scripting.Dictionary")
ar = Sheet1.Range("b3").Resize(4, 10) '2000
br = Sheet2.Range("b3").Resize(16, 18) '500
ReDim cr(1 To UBound(ar), 0 To 10)
For i = 1 To UBound(ar)
    For y = 1 To UBound(br)
        d.RemoveAll
        k = 0
        For x = 1 To 18
            d(br(y, x)) = ""
        Next
        For j = 1 To 10
            If d.Exists(ar(i, j)) Then k = k + 1
        Next
        cr(i, 10 - k) = cr(i, 10 - k) + 1
    Next
Next
Sheet3.Range("b3").Resize(i - 1, j) = cr
Set d = Nothing
End Sub

hzg312

xiangbaoan 发表于 2020-5-15 09:16
Option Explicit
Sub test()
Dim ar, br, d As Object, i&, j&, k&, x&, y&

万分感谢！！！
为什么代码复制保存后，执行了却没有结果，和2个表格中有空的单元格有关系吗？
还有如果“数据”表每行数据只取前6个数和“对比”表进行对比，对应修改那几个参数啊

xiangbaoan

………………

hzg312

xiangbaoan 发表于 2020-5-15 10:53
………………

太厉害了，高手就是不一样，谢谢啊
如果方便的话，能加你的qq或者微信吗？

xiangbaoan

hzg312 发表于 2020-5-15 13:54
太厉害了，高手就是不一样，谢谢啊
如果方便的话，能加你的qq或者微信吗？

VX 即 ID……