五个数按要求排列组合

yjh_27

beiounanhai 发表于 2020-12-27 22:10
随机选三个但是要满足上述的两个条件

按9L说的，按顺序选择：先选3个，再判顺序。参见附件

如果随机选3个则：先排序，再选3个。不需再判顺序

hcm19522

G1:I1=INDEX($A1:$E1,RANDBETWEEN(IF(COLUMN(A1)=1,1,MATCH(F1,1:1,)+1),2+COLUMN(A1)))

K1:N11{=IFERROR(INDEX($1:$1,MID(SMALL(IF((MMULT(N(MID(ROW($123:$345),{2,3},1)-MID(ROW($123:$345),{1,2},1)>0),{1;1})>1)*(MMULT(N(6-MID(ROW($123:$345),{1,2,3},1)>0),{1;1;1})>2),ROW($123:$345)),ROW(A1)),COLUMN(A1),1)),"")

一把小刀闯天下

'按图给你凑了一个结果，，，

Option Explicit

Sub test()
  Dim arr, i, j, k, m
  arr = [a1].CurrentRegion.Value
  ReDim brr(1 To 10 ^ 4, 1 To 3)
  For i = 1 To UBound(arr, 2) - 2
    For j = i + 1 To UBound(arr, 2) - 1
      For k = j + 1 To UBound(arr, 2)
        If arr(1, i) > arr(1, j) And arr(1, j) > arr(1, k) Or _
          arr(1, i) < arr(1, j) And arr(1, j) < arr(1, k) Then
          m = m + 1
          brr(m, 1) = arr(1, i)
          brr(m, 2) = arr(1, j)
          brr(m, 3) = arr(1, k)
        End If
      Next
    Next
  Next
  [a11].Resize(m + 10, 3) = brr
End Sub

笨鸟飞不高

VBA测试代码.zip (15.3 KB, 下载次数: 2)

2020-12-28 13:32 上传

点击文件名下载附件

笨鸟飞不高

Sub AwTest()
    Dim j%, a%, b%, c%, r&, arr
    Sheet1.Activate
    arr = [a1].CurrentRegion
    ReDim brr(1 To Rows.Count, 1 To 1)
    For a = 1 To UBound(arr, 2) - 2
        For b = a + 1 To UBound(arr, 2) - 1
            For c = a + 2 To UBound(arr, 2)
                If arr(1, a) < arr(1, b) And arr(1, b) < arr(1, c) Then
                    r = r + 1
                    brr(r, 1) = arr(1, a) & "," & arr(1, b) & "," & arr(1, c)
                ElseIf arr(1, a) > arr(1, b) And arr(1, b) > arr(1, c) Then
                    r = r + 1
                    brr(r, 1) = arr(1, a) & "," & arr(1, b) & "," & arr(1, c)
                End If
            Next
        Next
    Next
    [a12].Resize(r) = brr
End Sub

lmgz007

1. Sub 按顺序组合()
   
2.     Dim i, j, k, m, n, p, q, s&, sr
   
3.     Dim arr, brr, crr, drr
   
4.     n = 3     '给定的任意个数字中取 n个组合
   
5.     drr = Range("A1").CurrentRegion.Value
   
6.     m = UBound(drr, 2) - n + 2
   
7.     p = Application.Combin(m, 2)
   
8.     ReDim arr(1 To p)
   
9.     For i = 1 To m - 1
   
10.         For j = i + 1 To m
    
11.             k = k + 1
    
12.             arr(k) = i & "," & j
    
13.         Next j
    
14.     Next i
    
15.     For k = 3 To n
    
16.         q = 0      '计数器
    
17.         m = m + 1
    
18.         p = Application.Combin(m, k)
    
19.         ReDim brr(1 To p)
    
20.         For i = 1 To UBound(arr)
    
21.             s = Mid(arr(i), InStrRev(arr(i), ",") + 1)
    
22.             For j = s + 1 To m
    
23.                 q = q + 1
    
24.                 brr(q) = arr(i) & "," & j
    
25.             Next j
    
26.         Next i
    
27.         If k < n Then arr = brr
    
28.     Next k
    
29.     ReDim arr(1 To p, 1 To 3)
    
30.     q = 0      '计数器
    
31.     For i = 1 To p
    
32.         s = 0
    
33.         sr = ""
    
34.         crr = Split(brr(i), ",")     '索引从0开始
    
35.         For j = 0 To n - 2
    
36.             If drr(1, crr(j)) - drr(1, crr(j + 1)) > 0 Then s = s + 1 Else s = s - 1
    
37.             sr = sr & drr(1, crr(j)) & ","
    
38.         Next j
    
39.        sr = sr & drr(1, crr(n - 1))
    
40.         If Abs(s) = n - 1 Then q = q + 1: arr(q, 1) = sr
    
41.     Next i
    
42.     Range("B12").CurrentRegion = "" '.ClearContents
    
43.     Range("B12").Resize(q, 3) = arr
    
44. End Sub

复制代码

lmgz007

可以满足a 个数字中选择 b个组合。
附件：