限定元素个数组合数据求VBA

三票

liulang0808 发表于 2023-1-14 07:26
0 3 5 5 6 9
这段，有一个0，那么符合0-1，也符合1-3吧？另外一个3和一个9也是。两个5也是到底怎么划分 ...

根据J2:S2限定0—9每个数字个数

liulang0808

Sub 按钮1_Click()
    Set dd = CreateObject("scripting.dictionary")
    arr = [c5].CurrentRegion
    brr = [j1:s3]
    r = 0
    For j = 1 To UBound(arr)
        dd.RemoveAll
        t = True
        For i = 1 To UBound(arr, 2)
            dd(arr(j, i)) = dd(arr(j, i)) + 1
        Next i
        For Each k In dd.keys
            y = dd(k)
            If InStr(brr(3, k + 1), "~") > 0 Then
                crr = Split(brr(3, k + 1), "~")
                If Val(crr(0)) > y Or Val(crr(1)) < y Then
                    t = False
                    Exit For
                End If
            Else
                If Val(brr(3, k + 1)) <> y Then
                    t = False
                    Exit For
                End If
            End If
        Next k
        If t Then
            r = r + 1
            For i = 1 To UBound(arr, 2)
                arr(r, i) = arr(j, i)
            Next i
        End If
    Next j
    If r > 0 Then [aa1].Resize(r, UBound(arr, 2)) = arr
End Sub

liulang0808

供参考。。。。。。。。。。。。

三票

liulang0808 发表于 2023-1-14 08:04
Sub 按钮1_Click()
    Set dd = CreateObject("scripting.dictionary")
    arr = [c5].CurrentRegion

感谢！！有点小问题。按行提取，J3：S3限定元素出现个数，（0~1表示0或1个都成立，1~3表示出现1个、2个、3个都成立）的结果。限定的条件同时符合。提取的结果同时出现限定条件数字(1个1，1-3个3，2个5，1-2个6，1个9）

liulang0808

三票 发表于 2023-1-14 08:38
感谢！！有点小问题。按行提取，J3：S3限定元素出现个数，（0~1表示0或1个都成立，1 ...

把不符合的数据对应的模拟附件上传看下

fzxba

1. Sub test1() '删除第4行的内容后测试
   
2.   Dim ar, br(), cr(), Dict As Object, Flag As Boolean
   
3.   Dim i As Long, j As Long, k As Long, rowSize As Long
   
4.   Set Dict = CreateObject("Scripting.Dictionary")
   
5.   ar = Range("J1:S3").Value
   
6.   For i = 1 To UBound(ar, 2)
   
7.     If ar(3, i) <> 0 Then
   
8.       j = j + 1
   
9.       ReDim Preserve cr(1 To 3, 1 To j)
   
10.       cr(1, j) = ar(1, i)
    
11.       cr(2, j) = Split(ar(3, i), "~")(0) - 1
    
12.       cr(3, j) = Split(ar(3, i), "~")(UBound(Split(ar(3, i), "~"))) + 1
    
13.     End If
    
14.   Next
    
15.   ar = Range("C5").CurrentRegion
    
16.   ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
    
17.   For i = 1 To UBound(ar)
    
18.     Dict.RemoveAll
    
19.     For j = 1 To UBound(ar, 2)
    
20.       If Len(ar(i, j)) Then Dict(ar(i, j)) = Dict(ar(i, j)) + 1
    
21.     Next
    
22.     For j = 1 To UBound(cr, 2)
    
23.       k = Dict(cr(1, j))
    
24.       Flag = (k > cr(2, j) And k < cr(3, j))
    
25.       If Not Flag Then Exit For
    
26.     Next
    
27.     If Flag Then
    
28.       rowSize = rowSize + 1
    
29.       For j = 1 To UBound(ar, 2)
    
30.         br(rowSize, j) = ar(i, j)
    
31.       Next
    
32.     End If
    
33.   Next
    
34.   With Range("J5")
    
35.     .CurrentRegion.ClearContents
    
36.     If rowSize Then .Resize(rowSize, UBound(br, 2)) = br
    
37.   End With
    
38.   Set Dict = Nothing
    
39.   Beep
    
40. End Sub

复制代码

fzxba

审测试.rar (266.7 KB, 下载次数: 10)

2023-1-14 08:48 上传

点击文件名下载附件

补充，改第7行为 if len(ar(3,i)) then

三票

liulang0808 发表于 2023-1-14 08:40
把不符合的数据对应的模拟附件上传看下

以现在C5：H数据，提取的结果只有标黄色的两组（同时含有限定条件范围的数字）

三票

fzxba 发表于 2023-1-14 08:48

成立

liulang0808

三票 发表于 2023-1-14 09:14
以现在C5：H数据，提取的结果只有标黄色的两组（同时含有限定条件范围的数字）

按照楼主的要求，就是对应数字必须是0，3，5，6，9这五个数字的组合，并且满足次数才可以