如何使用VBA查找单元格的每种可能组合

时间:2018-07-02 18:15:13

标签: excel vba excel-vba

我目前正在使用Excel中的VBA,并且尝试创建一个代码,该代码将允许用户选择具有唯一数据的列数,然后要求他们选择范围,以便可以确定范围可能的组合数量,然后将其打印到正确的列中。我已经编写了可以在有限数量的列中执行此操作的代码,但是我想根据用户输入来编写可以执行任意数目的列的通用代码。这是我的原始代码。

Sub Every_Combination()

Dim c1() As Variant
Dim c2() As Variant
Dim c3() As Variant
Dim c4() As Variant
Dim c5() As Variant
Dim c6() As Variant
Dim out() As Variant
Dim j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long


Dim col1 As Range
Dim col2 As Range
Dim col3 As Range
Dim col4 As Range
Dim col5 As Range
Dim col6 As Range
Dim out1 As Range


Set col1 = Range("A2", Range("A2").End(xlDown))
Set col2 = Range("B2", Range("B2").End(xlDown))
Set col3 = Range("C2", Range("C2").End(xlDown))
Set col4 = Range("D2", Range("D2").End(xlDown))
Set col5 = Range("E2", Range("E2").End(xlDown))
Set col6 = Range("F2", Range("F2").End(xlDown))

c1 = col1
c2 = col2
c3 = col3
c4 = col4
c5 = col5
c6 = col6

Set out1 = Range("A3", Range("F3").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6)))
out = out1

j = 1
k = 1
l = 1
m = 1
n = 1
o = 1
p = 1

Do While j <= UBound(c1)
    Do While k <= UBound(c2)
        Do While l <= UBound(c3)
            Do While m <= UBound(c4)
                Do While n <= UBound(c5)
                    Do While p <= UBound(c6) ' This now loops correctly
                    out(o, 1) = c1(j, 1)
                    out(o, 2) = c2(k, 1)
                    out(o, 3) = c3(l, 1)
                    out(o, 4) = c4(m, 1)
                    out(o, 5) = c5(n, 1)
                    out(o, 6) = c6(p, 1)
                    o = o + 1
                    p = p + 1
                    Loop
                    p = 1
                    n = n + 1
                Loop
                n = 1
                m = m + 1
            Loop
            m = 1
            l = l + 1
        Loop
        l = 1
        k = k + 1
    Loop
    k = 1
    j = j + 1
Loop

out1.Value = out

End Sub

这适用于有限数量的数据,但是我希望能够将其用于任何大小的数据,而无需编辑代码。当前,这就是我的新代码所需要的,但是对于何时使用“ As Range”以及如何在“ For”循环中使用它们,我有些困惑。

Sub Test()

Dim i As Integer
Dim c() As Variant
Dim col() As Variant
Dim out() As Variant

Dim UniqueColumns As Integer
UniqueColumns = Application.InputBox(Prompt:="Enter the number of unique columns", Type:=1)
ReDim c(1 To UniqueColumns)
ReDim col(1 To UniqueColumns)

For i = 1 To UniqueColumns

    c(i) = "c" & i
    col(i) = "col" & i

    Set col(i) = Application.InputBox(Prompt:="Please select a range with your Mouse to be bolded.", Title:="SPECIFY RANGE", Type:=8)
    c(i) = col(i)

Next i

End Sub

感谢您的帮助!

0 个答案:

没有答案