[已解决]请教：三个数组各取一行，找公共数，并删除指定数

lygyjt

在“组合、去重”表中，三个数组（H:AN，AX:CD，CN:DT）分别各取一行，查找这三行的公共数，将结果放在A1开始的下面。遍历计算。

在AJ1:BP1中，输入N个数值，将这些数值在此表A:AG中删除。被删除数值的行中，它的右侧数据左移。 三个数组各取一行，查找公共数，并删除指定数.rar (22.84 KB, 下载次数: 4)

2021-6-30 11:09 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-6-30 11:09

Dim a(1 To 3), d, list, r
Sub demo()
   Set d = Nothing
   Set d = CreateObject("Scripting.Dictionary")
   Set list = CreateObject("System.Collections.ArrayList")
   a(1) = Sheets(1).Range("h2:an" & Sheets(1).[h2].End(4).Row)
   a(2) = Sheets(1).Range("ax2:cd" & Sheets(1).[ax2].End(4).Row)
   a(3) = Sheets(1).Range("cn2:dt" & Sheets(1).[cn2].End(4).Row)
   Sheets(2).[a:ag].ClearContents
   r = 0: com 1
End Sub
Sub com(n)
   If n > 3 Then
      list.Clear
      For Each Key In d.keys
         If d(Key) = 3 Then list.Add Key
      Next
      If list.Count Then
         r = r + 1
         list.Sort
      Cells(r, 1).Resize(1, list.Count) = list.ToArray
      End If
      Exit Sub
   End If
   For i = 1 To UBound(a(n))
      For j = 1 To UBound(a(n), 2)
         Key = a(n)(i, j)
         If Key <> "" Then
            d(Key) = d(Key) + 1
         End If
      Next
      com n + 1
      For j = 1 To UBound(a(n), 2)
         Key = a(n)(i, j)
         d(Key) = d(Key) - 1
      Next
   Next
End Sub
Sub del()
   Set d = Nothing
   Set d = CreateObject("Scripting.Dictionary")
   b = [aj2:bp2]
   For i = 1 To UBound(b, 2)
      If b(1, i) = 0 Then Exit For
      d(b(1, i)) = 1
   Next
   b = Range("a1:ag" & [a1].End(4).Row)
   For i = 1 To UBound(b)
      c = 0
      For j = 1 To UBound(b, 2)
         If d(b(i, j)) = 0 Then
            c = c + 1: b(i, c) = b(i, j)
            If j <> c Then b(i, j) = ""
         End If
      Next
   Next
   [a1].Resize(UBound(b), UBound(b, 2)) = b
End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

Dim a(1 To 3), d, list, r
Sub demo()
   Set d = Nothing
   Set d = CreateObject("Scripting.Dictionary")
   Set list = CreateObject("System.Collections.ArrayList")
   a(1) = Sheets(1).Range("h2:an" & Sheets(1).[h2].End(4).Row)
   a(2) = Sheets(1).Range("ax2:cd" & Sheets(1).[ax2].End(4).Row)
   a(3) = Sheets(1).Range("cn2:dt" & Sheets(1).[cn2].End(4).Row)
   Sheets(2).[a:ag].ClearContents
   r = 0: com 1
End Sub
Sub com(n)
   If n > 3 Then
      list.Clear
      For Each Key In d.keys
         If d(Key) = 3 Then list.Add Key
      Next
      If list.Count Then
         r = r + 1
         list.Sort
      Cells(r, 1).Resize(1, list.Count) = list.ToArray
      End If
      Exit Sub
   End If
   For i = 1 To UBound(a(n))
      For j = 1 To UBound(a(n), 2)
         Key = a(n)(i, j)
         If Key <> "" Then
            d(Key) = d(Key) + 1
         End If
      Next
      com n + 1
      For j = 1 To UBound(a(n), 2)
         Key = a(n)(i, j)
         d(Key) = d(Key) - 1
      Next
   Next
End Sub
Sub del()
   Set d = Nothing
   Set d = CreateObject("Scripting.Dictionary")
   b = [aj2:bp2]
   For i = 1 To UBound(b, 2)
      If b(1, i) = 0 Then Exit For
      d(b(1, i)) = 1
   Next
   b = Range("a1:ag" & [a1].End(4).Row)
   For i = 1 To UBound(b)
      c = 0
      For j = 1 To UBound(b, 2)
         If d(b(i, j)) = 0 Then
            c = c + 1: b(i, c) = b(i, j)
            If j <> c Then b(i, j) = ""
         End If
      Next
   Next
   [a1].Resize(UBound(b), UBound(b, 2)) = b
End Sub

祝順心，南無阿彌陀佛！

cutecpu

您好，
找公共數 跟 刪除指定數值
可以做成一個功能嗎？
這樣可以在找公共數的時候，就先排除指定數值了
不用全找出來後，再刪除喔！

lygyjt

cutecpu 发表于 2021-6-30 13:17
您好，
找公共數 跟 刪除指定數值
可以做成一個功能嗎？

再次谢谢版主的关注！不能一起的，因为，得先从公共数中，大致看下规律，然后再决定输入什么数。

cutecpu

lygyjt 发表于 2021-6-30 16:13
再次谢谢版主的关注！不能一起的，因为，得先从公共数中，大致看下规律，然后再决定输入什么数。

喔喔~~了解

lygyjt

cutecpu 发表于 2021-6-30 11:09
Dim a(1 To 3), d, list, r
Sub demo()
   Set d = Nothing

再次感谢版主的厚爱！为我付出了许多宝贵的时间和汗水！有点事想向版主请教，能否通过我的QQ（577199088）申请？因为那里沟通方便些。