したがって、7つの列をループし、最初の7つの列のすべての組み合わせを含む他の7つの列を返すこのマクロがあります。
私が抱えているエラーは、リスト内のアイテムの数を取得するために上限を使用したことです。理由はわかりませんが、列にアイテムが1つしかない場合、オーバーフローエラーが発生します。VBAはこれを行うための最良の方法ではないと思いますが、データを使用する残りの作業はExcelで行われるため、データを近くに保持する方が簡単です。
この行でオーバーフローしますSetout1= Range（ "K2"、Range（ "Q2"）。Offset（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 x 1になるようにReDimsされるため、1セルの範囲に一致します。現在、1つ以上のアイテムで機能します。みんなの助けてくれてありがとう。