求b2到v8里每行数字出现1次组成7位数，列出所有组合。

王拥军 · 发表于 2024-10-5 10:59

求b2到v8里每行数字出现1次组成7位数，列出所有组合。.rar (1.76 KB, 下载次数: 10)

gwjkkkkk · 发表于 2024-10-5 11:17

请参考。。。

gwjkkkkk · 发表于 2024-10-5 11:18

请参考。。。

王拥军 · 发表于 2024-10-5 12:16

求样本1与样本2的交集

求样本1与样本2的交集.rar (18.07 KB, 下载次数: 2)

longwin · 发表于 2024-10-5 15:05

附件供参考：
Sub test20241005()
'求交集
Set d = CreateObject("scripting.dictionary")
arr = [ac2].CurrentRegion.Value
brr = [ak2].CurrentRegion.Value
ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
d.RemoveAll
For j = 1 To UBound(arr, 2)
d(arr(i, j)) = d(arr(i, j)) + 1
d(brr(i, j)) = d(brr(i, j)) + 1
Next
m = 0
For Each Key In d.keys
If d(Key) > 1 Then
m = m + 1
crr(i, m) = Key
End If
Next
Next
[b1].Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub

gwjkkkkk · 发表于 2024-10-5 16:16

Option Explicit
Sub TEST3()
Dim ar, br, i&, j&, r&, strJoin$, strJoin1$

Application.ScreenUpdating = False

ar = [AC1].CurrentRegion.Value
br = [AK1].CurrentRegion.Value
ReDim cr(1 To UBound(ar), 1 To UBound(ar, 2))

For i = 2 To UBound(ar)
      strJoin1 = Join(Application.Index(ar, i))
      strJoin = strJoin & "," & strJoin1
Next i
strJoin = strJoin & ","

For i = 2 To UBound(br)
      strJoin1 = "," & Join(Application.Index(br, i)) & ","
      If InStr(strJoin, strJoin1) Then
         r = r + 1
         For j = 1 To UBound(br, 2)
            cr(r, j) = br(i, j)
         Next j
      End If
Next i

If r Then
      [Az1].Resize(r, UBound(cr, 2)) = cr
Else
      MsgBox "没有交集"
End If

Application.ScreenUpdating = True
Beep
End Sub

gwjkkkkk · 发表于 2024-10-5 16:17

请参考。。。

		自动登录	找回密码
密码			免费注册

[求助] 求b2到v8里每行数字出现1次组成7位数，列出所有组合。

评分

评分