Question

我有一个代码，它根据8列的输入生成排列，并将列连接在一起。它到目前为止工作得很好，但我想出了一个问题。当填充超过2行时它可以工作。因此，如果A-H中的任何列只有第10行中的一个条目，它就会崩溃。如果第8列只有A然后崩溃

，所有8列的行都用A，B，C填充

我也试过

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编辑器中将选项设置为require变量声明。这将在任何新模块的开头放置Option Explicit，并确保您不仅声明所有变量（您没有在此代码中），而且还有助于避免拼写错误。

Excel组合生成器

1 个答案: