у меня есть код, который генерирует перестановку на основе входных данных 8 столбцов и объединяет столбцы вместе. пока работает отлично, но я столкнулся с проблемой. он работает, когда заполнено более 2 строк. поэтому, если в строке 10 есть только одна запись для любого из столбцов от A-H, происходит сбой. строки заполнены A, B, C во всех 8 столбцах, если в столбце 8 есть только A, тогда происходит сбой
я тоже пробовал
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
