问题
i have a code that generates a permutation based on the inputs of 8 columns and concatenates the columns together. it works great so far but i came up with a problem. it works when more than 2 rows are filled. so if theres only one entry in row 10 for any of the columns from A-H it crashes. the rows are filled with A,B,C across all 8 columns, if column 8 only had A then it crashes
I've also tried
Set col1 = Range(Range("A10"), Range("A" & Rows.Count).End(xlUp))
instead of
Set col1 = Range("A10", Range("A10").End(xlDown))
but then there's a type mismatch error.
Any help would be great. This is the whole code:
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
回答1:
You have multiple problems:
Set col1 = Range("A10", Range("A10").End(xlDown))
c1 = col1
If col1 only has row 10 populated, this sequence results in c1 being a variant array with dimensions (1 to 1048567, 1 to 1)
Better would be:
Set col1 = Range("A10", Cells(Rows.Count, "A").End(xlUp))
but, with that, and only a single cell populated in a column, c1 will no longer be an Array.
So, one solution, maintaining most of your algorithm, is to use this sequence to set up your columns and variant arrays:
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
Finally, you should, in the VB editor, set the option to require variable declaration. This will place Option Explicit at the beginning of any new modules, and ensure you not only declare all of your variables (you did not in this code), but also will help in avoiding typos.
来源：https://stackoverflow.com/questions/28677005/excel-combination-generator