Excel组合生成器 [英] Excel Combination Generator
本文介绍了Excel组合生成器的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我也尝试过
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
解决方案
您遇到了多个问题:
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放在任何新模块的开头，并确保您不仅声明所有变量(您未在此代码中声明)，而且还有助于避免输入错误.
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
解决方案
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.
这篇关于Excel组合生成器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
