[已解决]请教老师：查找两个数组中，有相同指定个数的行

lygyjt

请教各位老师：
说明：
        如果“原始数据1”中，某行正好有“A2”个数据，与“原始数据2”中的某行完全相同（不看数据的位置，只要有就行），就将“原始数据1”中的这行，提取到此“结果”表D列开始的地方，要带序号。并且把“原始数据2”与之对应的序号，放在此行隔1个单元格的后面，有几个放几个。
        所谓“正好”，是指多一个、少一个都不行
        比如：A2=6，假如“原始数据1”中，序号为1的那行，正好有6个数据与“原始数据2”中的序号为10的那行完全相同（不看数据的位置，只要有就行），就将“原始数据1”序号为1的那行，放到“结果”表的D1，并且把“原始数据2”与之对应的序号，放在此行L1的后面，有几个放几个。以此类推。
        再比如：A2=4，假如“原始数据1”中，序号为2的那行，有5个数据与“原始数据2”中的序号为11的那行完全相同（不看数据的位置，只要有就行）， 那么，“原始数据1”中，序号为2的那行，不能被选上。因为，它不是正好有4个相同数据。

具体例子请见： 查找两个数组的相同行.rar (19.73 KB, 下载次数: 6)

2022-12-3 11:05 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

cutecpu

2022-12-3 11:06

Sub demo()
   Set d = CreateObject("scripting.dictionary")
   a = Sheet1.[a1].CurrentRegion
   b = Sheet2.[a1].CurrentRegion
   cnt = [a2]
   Sheet3.UsedRange.Offset(, 1).ClearContents
   For i = 1 To UBound(a)
      d.RemoveAll: s = a(i, 1) & ","
      For k = 2 To 7
         d(a(i, k)) = 1: s = s & a(i, k) & ","
      Next
      n = 0
      For j = 1 To UBound(b)
         c = 0
         For k = 2 To 7
            If d(b(j, k)) Then c = c + 1
         Next
         If c = cnt Then s = s & "," & b(j, 1): n = n + 1
      Next
      If n Then [d1].Offset(r).Resize(, n + 8) = Split(s, ","): r = r + 1
   Next
End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

Sub demo()
   Set d = CreateObject("scripting.dictionary")
   a = Sheet1.[a1].CurrentRegion
   b = Sheet2.[a1].CurrentRegion
   cnt = [a2]
   Sheet3.UsedRange.Offset(, 1).ClearContents
   For i = 1 To UBound(a)
      d.RemoveAll: s = a(i, 1) & ","
      For k = 2 To 7
         d(a(i, k)) = 1: s = s & a(i, k) & ","
      Next
      n = 0
      For j = 1 To UBound(b)
         c = 0
         For k = 2 To 7
            If d(b(j, k)) Then c = c + 1
         Next
         If c = cnt Then s = s & "," & b(j, 1): n = n + 1
      Next
      If n Then [d1].Offset(r).Resize(, n + 8) = Split(s, ","): r = r + 1
   Next
End Sub

祝順心，南無阿彌陀佛！

qdtzq

没有认真测试，使用情况请反馈

lygyjt

qdtzq 发表于 2022-12-7 14:36
没有认真测试，使用情况请反馈

谢谢qdtzq老师的指教！结果完全正确。刚想给您最佳，另外一个帖子上来了，格式更规整些。请您见谅啊！下次还希望能得到您的指教。

lygyjt

cutecpu 发表于 2022-12-3 11:06
Sub demo()
   Set d = CreateObject("scripting.dictionary")
   a = Sheet1.[a1].CurrentRegion

再次谢谢版主大人的仁爱之心！能得到您多次帮助，不胜荣幸！