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

王拥军

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

2024-10-5 10:59 上传

点击文件名下载附件

gwjkkkkk

请参考。。。

gwjkkkkk

请参考。。。

王拥军

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

2024-10-5 12:16 上传

点击文件名下载附件

longwin

附件供参考：
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

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

请参考。。。