Excel組合生成器

Question

我有一個代碼可以根據8列的輸入生成一個排列並將列連接在一起。它到目前爲止效果很好，但我提出了一個問題。它在超過2行填充時有效。所以如果在第10行中只有一個來自A-H的列的條目崩潰。行充滿了A，B，C在所有8列，如果第8列只有一則崩潰

我也試過

Set col1 = Range(Range("A10"), Range("A" & Rows.Count).End(xlUp)) 

，而不是

Set col1 = Range("A10", Range("A10").End(xlDown)) 

但那麼存在類型不匹配錯誤。

任何幫助將是偉大的。這是整個代碼：

Sub combinations() 

Dim out() As Variant 
Dim f, g, h, i, j, k, l, m 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 col8 As Range 
Dim out1 As Range 

'Set col1 = Range("A10", Range("A10").End(xlDown)) 
Set col1 = Range(Range("A10"), Range("A" & Rows.Count).End(xlUp)) 
Set col2 = Range("B10", Range("B10").End(xlDown)) 
Set col3 = Range("C10", Range("C10").End(xlDown)) 
Set col4 = Range("D10", Range("D10").End(xlDown)) 
Set col5 = Range("E10", Range("E10").End(xlDown)) 
Set col6 = Range("F10", Range("F10").End(xlDown)) 
Set col7 = Range("G10", Range("G10").End(xlDown)) 
Set col8 = Range("H10", Range("H10").End(xlDown)) 

c1 = col1 
c2 = col2 
c3 = col3 
c4 = col4 
c5 = col5 
c6 = col6 
c7 = col7 
c8 = col8 

'initializes each column from column1-column8 as Range, sets the size of the range from row10 to last row 

Set out1 = Range("M1", Range("T1").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6) * UBound(c7) * UBound(c8))) 
out = out1 

'creates a range for the output 

f = 1 
g = 1 
h = 1 
i = 1 
j = 1 
k = 1 
l = 1 
m = 1 
n = 1 

Do While f <= UBound(c1) 

    Do While g <= UBound(c2) 
     Do While h <= UBound(c3) 
      Do While i <= UBound(c4) 

    Do While j <= UBound(c5) 
     Do While k <= UBound(c6) 
      Do While l <= UBound(c7) 
      Do While m <= UBound(c8) 
      out(n, 1) = c1(f, 1) 
      out(n, 2) = c2(g, 1) 
      out(n, 3) = c3(h, 1) 
      out(n, 4) = c4(i, 1) 
      out(n, 5) = c1(j, 1) 
      out(n, 6) = c2(k, 1) 
      out(n, 7) = c3(l, 1) 
      out(n, 8) = c4(m, 1) 
      'goes down one column and grabs each cells value 

      n = n + 1 
      m = m + 1 
     Loop 
     m = 1 
     l = l + 1 
    Loop 
    l = 1 
    k = k + 1 
Loop 
k = 1 
j = j + 1 
Loop 
     j = 1 
     i = i + 1 
    Loop 
    i = 1 
    h = h + 1 
Loop 
h = 1 
g = g + 1 
Loop 
g = 1 
f = f + 1 
Loop 

'repeats process for all 8 columns 

out1.Value = out 

'places values in the output range "out1" 


Dim LastRow As Long 
    LastRow = Cells(Rows.Count, "M").End(xlUp).Row 

    'Range("Z1:Z" & LastRow).Formula = "=M1 & "" | "" & N1 & "" | "" & O1 & "" | "" & P1 & "" | "" & Q1 & "" | "" & R1 & "" | "" & S1 & "" | "" & T1 " 


    Range("Z1:Z" & LastRow).Formula = "=M1 & $F$3 & N1 & $F$3 & O1 & $F$3 & P1 & $F$3 & Q1 & $F$3 & R1 & $F$3 & S1 & $F$3 & T1 " 


    'concatentates the cells from column M-T, seperated by the delimiter in cell F3 


    Range("Z1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Range("A1").Select 
    Sheets("Sheet2").Select 
    Columns("F").ColumnWidth = 120 
    Range("F2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Range("A1").Select 

    'Copies the concatenated output, pastes in sheet2 as values 

End Sub 

Answer 1

您有多個問題：

Set col1 = Range("A10", Range("A10").End(xlDown)) 
c1 = col1 

如果COL1僅已排10填充，在C1此序列的結果是一個變量數組，其尺寸（1至1048567，1爲1）

更好是：

Set col1 = Range("A10", Cells(Rows.Count, "A").End(xlUp)) 

但是，條件是，只有一個單一的單元填充在一列中，c1將不再是一個數組。

所以，一個解決方案，保持大部分的算法，就是用這個順序來設置列和變長數組：

Dim c1, c2, c3, c4, c5, c6, c7, c8 

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 col8 As Range 
Dim out1 As Range 

'Set col1 = Range("A10", Range("A10").End(xlDown)) 
Set col1 = Range("A10", Cells(Rows.Count, "A").End(xlUp)) 
Set col2 = Range("B10", Cells(Rows.Count, "b").End(xlUp)) 
Set col3 = Range("C10", Cells(Rows.Count, "c").End(xlUp)) 
Set col4 = Range("D10", Cells(Rows.Count, "d").End(xlUp)) 
Set col5 = Range("E10", Cells(Rows.Count, "e").End(xlUp)) 
Set col6 = Range("F10", Cells(Rows.Count, "f").End(xlUp)) 
Set col7 = Range("G10", Cells(Rows.Count, "g").End(xlUp)) 
Set col8 = Range("H10", Cells(Rows.Count, "h").End(xlUp)) 



c1 = col1 
    If Not IsArray(c1) Then 
     ReDim c1(1, 1) 
     c1(1, 1) = col1.Value 
    End If 
c2 = col2 
    If Not IsArray(c2) Then 
     ReDim c2(1, 1) 
     c2(1, 1) = col1.Value 
    End If 
c3 = col3 
    If Not IsArray(c3) Then 
     ReDim c3(1, 1) 
     c3(1, 1) = col1.Value 
    End If 
c4 = col4 
    If Not IsArray(c4) Then 
     ReDim c4(1, 1) 
     c4(1, 1) = col1.Value 
    End If 
c5 = col5 
    If Not IsArray(c5) Then 
     ReDim c5(1, 1) 
     c5(1, 1) = col1.Value 
    End If 
c6 = col6 
    If Not IsArray(c6) Then 
     ReDim c6(1, 1) 
     c6(1, 1) = col1.Value 
    End If 
c7 = col7 
    If Not IsArray(c7) Then 
     ReDim c7(1, 1) 
     c7(1, 1) = col1.Value 
    End If 
c8 = col8 
    If Not IsArray(c8) Then 
     ReDim c8(1, 1) 
     c8(1, 1) = col1.Value 
    End If  

最後，你應該在VB編輯器，設置選項需要變量聲明。這將在任何新模塊的開始處放置Option Explicit，並確保您不僅聲明所有變量（不在此代碼中），而且還將幫助避免輸入錯誤。