求一个按照数字要求提取相同包含数字显示在一行

飞越一切

烦请大神给个VBA,谢谢！

提取相同数字数组.zip (9.37 KB, 下载次数: 9)

2024-7-26 18:31 上传

点击文件名下载附件

小凡、、、

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, cr, i&, j&, k&, m&, n&, iNum&, iColSize&, strTemp$
   
    Application.ScreenUpdating = False
   
    With [A1].CurrentRegion
        ar = Intersect(.Offset(0), .Offset(1)).Value
    End With
    ReDim br(1 To UBound(ar), 1 To UBound(ar) - 1)
    iNum = [D1].Value
   
    For i = 1 To UBound(ar)
        strTemp = "," & ar(i, 1) & ","
        m = 0
        For j = 1 To UBound(ar)
            If j <> i Then
                n = 0
                cr = Split(ar(j, 1), ",")
                For k = 0 To UBound(cr)
                    If InStr(strTemp, "," & cr(k) & ",") Then
                        n = n + 1
                        If n = iNum Then Exit For
                    End If
                Next k
                If n = iNum Then m = m + 1: br(i, m) = ar(j, 1)
            End If
        Next j
        If m > iColSize Then iColSize = m
    Next i
   
    [I2].Resize(10 ^ 3, 10 ^ 3).Clear
    If iColSize Then [I2].Resize(UBound(br), iColSize) = br
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

...................

cnmlgb9998

刚才用PQ完美解决。结果 ，一不小心点了一个 删除步骤。。。。。

没保存，不想再重做了。

飞越一切

gwjkkkkk 发表于 2024-7-26 19:38
...................

大神烦请改一下，需要把被查找数组（A列下面的每一个数组）显示在结果的第一个位置，（数组+查找结果），A列下面的每一个数组，都需要从第一个数组查找到最后最后一个数组，结果中不能有重复的数组出现，非常感谢

飞越一切

小凡、、、 发表于 2024-7-26 19:10

大哥，把代码复制一下呗，烦请改一下，把被查找数组显示在结果行里第一个位置，结果里面不能有重复数组，谢谢

ynzsvt

飞越一切 发表于 2024-7-27 14:58
大神烦请改一下，需要把被查找数组（A列下面的每一个数组）显示在结果的第一个位置，（数组+查找结果）， ...

这下子迷糊了

飞越一切

ynzsvt 发表于 2024-7-27 15:10
这下子迷糊了

假如，A2的结果，把A2显示在结果里，排在第一个位置