所以我有这个循环遍历7列的宏，并返回包含前7列的每个组合的7个其他列。
我遇到的错误是我使用上限来获取列表中的项目数。我不知道为什么，但是当我在一列中只有一个项目时出现溢出错误。我认为VBA不是最好的方法，但是我们对数据的其余工作是在excel中完成的，因此更容易保持接近。
它在这条线上溢出 设置out1 =范围（“K2”，范围（“Q2”）。偏移（UBound（c1）* UBound（c2）* UBound（c3）* UBound（c4）* UBound（c5）* UBound（c6）* UBound（ C7）））
我在StackOverflow上找到了相同组合问题的递归解决方案，但是当列只有1个项时，它会遇到同样的问题。我应该做一个if案例吗？我认为它必须是计算出上限的东西。 这是代码。
Sub Final()
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 c7() As Variant
Dim out() As Variant
Dim j, k, l, m, n, o, p, q 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 col7 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))
Set col7 = Range("G2", Range("G2").End(xlDown))
c1 = col1
c2 = col2
c3 = col3
c4 = col4
c5 = col5
c6 = col6
c7 = col7
Set out1 = Range("K2", Range("Q2").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6) * UBound(c7)))
out = out1
j = 1
k = 1
l = 1
m = 1
n = 1
o = 1
p = 1
q = 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 o <= UBound(c6)
Do While p <= UBound(c7)
out(q, 1) = c1(j, 1)
out(q, 2) = c2(k, 1)
out(q, 3) = c3(l, 1)
out(q, 4) = c4(m, 1)
out(q, 5) = c5(n, 1)
out(q, 6) = c6(o, 1)
out(q, 7) = c7(p, 1)
q = q + 1
p = p + 1
Loop
p = 1
o = o + 1
Loop
o = 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
感谢您的帮助。 我知道这不是最好的代码，但它确实有用。
解
Set col1 = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Set col2 = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Set col3 = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
Set col4 = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
Set col5 = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp))
Set col6 = Range(Range("F2"), Range("F" & Rows.Count).End(xlUp))
Set col7 = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp))
If col1.Cells.Count = 1 Then
ReDim c1(1 To 1, 1 To 1)
c1(1, 1) = col1.Value
Else
c1 = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
End If
If col2.Cells.Count = 1 Then
ReDim c2(1 To 1, 1 To 1)
c2(1, 1) = col1.Value
Else
c2 = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
End If
If col3.Cells.Count = 1 Then
ReDim c3(1 To 1, 1 To 1)
c3(1, 1) = col3.Value
Else
c3 = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
End If
If col4.Cells.Count = 1 Then
ReDim c4(1 To 1, 1 To 1)
c4(1, 1) = col4.Value
Else
c4 = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
End If
If col5.Cells.Count = 1 Then
ReDim c5(1 To 1, 1 To 1)
c5(1, 1) = col5.Value
Else
c5 = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp))
End If
If col6.Cells.Count = 1 Then
ReDim c6(1 To 1, 1 To 1)
c6(1, 1) = col6.Value
Else
c6 = Range(Range("F2"), Range("F" & Rows.Count).End(xlUp))
End If
If col7.Cells.Count = 1 Then
ReDim c7(1 To 1, 1 To 1)
c7(1, 1) = col7.Value
Else
c7 = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp))
End If
这将数组重新排列为1乘1，因此它们匹配1个单元格的范围。适用于1件以上的商品。感谢大家的帮助。