如何使vba按我需要的方式工作?

我猜你想从10个中随机选择6个

Sub Combos()

    Dim i As Integer, j As Integer, k As Integer, n As Integer
    Dim c As Integer, digit As Integer
    Dim b As String, bb As String
    Dim grp, arr(1 To 1025, 1 To 10) As Long, cols

    ' group data
    grp = Range("B1:C10").Value

    For j = 0 To 31
       b = CStr(WorksheetFunction.Dec2Bin(j, 5))
       For k = 0 To 31
          bb = b & CStr(WorksheetFunction.Dec2Bin(k, 5))
          i = j * 32 + k + 1

          ' select 6 of the 10 columns
          cols = SixFromTen
          Range("V" & i + 1) = Join(cols, ",") ' show combo
          For c = 0 To 5
              n = cols(c) '
              'Debug.Print j, k, n
              digit = CInt(Mid(bb, n, 1))  ' binary digit
              arr(i, c + 1) = grp(n, digit + 1)
          Next
       Next
    Next

    Range("O2").Resize(1025, 6).Value = arr
    MsgBox "Done"

End Sub


Function SixFromTen() As Variant

    Dim num As New Collection, ar(5) As String
    Dim i As Integer, n As Integer
    Dim a As Integer, b As Integer, tmp As Integer

    For n = 1 To 10
        num.Add n
    Next

    For i = 0 To 5
        n = 1 + Int(Rnd() * num.Count)
        ar(i) = num(n)
        num.Remove n
    Next

    'bubble sort
    For a = 0 To 4
        For b = a + 1 To 5
            If CInt(ar(a)) > CInt(ar(b)) Then
                tmp = ar(a)
                ar(a) = ar(b)
                ar(b) = tmp
            End If
        Next
    Next
   
    SixFromTen = ar
    
End Function

或者从10中移除4,以正确顺序保留6。

Function SixFromTen() As Variant
    Dim num As New Collection, ar(5) As String
    Dim i As Integer, n As Integer

    For n = 1 To 10: num.Add n: Next

    ' remove 4
    For i = 0 To 3
        n = 1 + Int(Rnd() * num.Count)
        num.Remove n
    Next

    For i = 0 To 5: ar(i) = num(i + 1): Next
    SixFromTen = ar   
End Function

正如AcsErno所指出的,问题是您的程序正在生成十列数字,但输出仅为六列。删除四列会导致许多重复的组合,因为这四列中唯一的部分已被删除。

解决方案是只生成六列,因此允许每个列保持唯一。我重写了你的程序,只生成六列:

Sub Combs()
    Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
    Dim i As Long, arr(1 To 1025, 1 To 6) As Long
    Dim grp() As Variant
    
    grp = Range("B1:C6").Value
    
    For a = 1 To 2
        For b = 1 To 2
            For c = 1 To 2
                For d = 1 To 2
                    For e = 1 To 2
                        For f = 1 To 2
                            i = i + 1
                            arr(i, 1) = grp(1, a)
                            arr(i, 2) = grp(2, b)
                            arr(i, 3) = grp(3, c)
                            arr(i, 4) = grp(4, d)
                            arr(i, 5) = grp(5, e)
                            arr(i, 6) = grp(6, f)
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a

    Application.ScreenUpdating = False
    Range("H2").Resize(1025, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

举个例子:

如何输入组合数字

Sub Combs()
    Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
    Dim i As Long, arr(1 To 1025, 1 To 6) As Long
    Dim grp() As Variant
    
    grp = Range("B1:E6").Value 'Increasing the width
    
    For a = 1 To 2
        For b = 1 To 2
            For c = 1 To 4 'Changed from 2 to 4
                For d = 1 To 4 'Changed from 2 to 4
                    For e = 1 To 4 'Changed from 2 to 4
                        For f = 1 To 4 'Changed from 2 to 4
                            i = i + 1
                            arr(i, 1) = grp(1, a)
                            arr(i, 2) = grp(2, b)
                            arr(i, 3) = grp(3, c)
                            arr(i, 4) = grp(4, d)
                            arr(i, 5) = grp(5, e)
                            arr(i, 6) = grp(6, f)
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
    Application.ScreenUpdating = False
    Range("H2").Resize(1025, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

我将四个For循环替换为一个遍历列的循环:

Sub Combs()
    Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, alt As Long
    Dim i As Long, arr(1 To 1025, 1 To 6) As Long
    Dim grp() As Variant
    
    grp = Range("B1:c10").Value
    
    For a = 1 To 2
        For b = 1 To 2
            For c = 1 To 2
                For d = 1 To 2
                    For e = 1 To 2
                        For f = 1 To 2
                            For alt = 0 To 4
                            'Interating the used section through the full 10 columns.
                            'Only six columns are used in each combo, but we change which six are used from those 10
                                i = i + 1
                                arr(i, 1) = grp(1 + alt, a)
                                arr(i, 2) = grp(2 + alt, b)
                                arr(i, 3) = grp(3 + alt, c)
                                arr(i, 4) = grp(4 + alt, d)
                                arr(i, 5) = grp(5 + alt, e)
                                arr(i, 6) = grp(6 + alt, f)
                            Next alt
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
    Application.ScreenUpdating = False
    Range("H2").Resize(1025, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

注:这将产生320个独特的组合。这并不是所有这些数字对的可能组合,为了获得更完整的列表,您可以添加额外的数组并交换列位置。