使用列中项目列表的随机数据生成器

Question

我需要采用一系列填充列并生成许多行具有随机值的组合。

我设法编写了一些既不高效也不时尚的 VBA - 但总的来说，它是有效的。

除了一个问题之外的所有内容，我稍后会讨论这个问题。

代码读取 10 列中的每一列，输出到一个代码组合，并在第 11 列中添加一个随机值。 下图显示了 10 个项目列表的输入源示例：

当前输出显示列表的合并，具有随机值：

我遇到的问题是，如果其中一个输入列只有 1 个项目，则 UBound() 会因类型不匹配而失败。 这将失败：

在名为 ListDims 的选项卡中设置以下字段后，请使用以下代码运行和测试。

我确信可以通过使用数组来简化整个代码，因此请随意提供更简单、更快的解决方案。

Sub RandomCombo()
    Dim wsOutSheet As Worksheet
       
    'Change this to point to the start column of the first dimension output
    lnStartcol = 13
    lnNoOfDims = 10
    
    ListA = Application.WorksheetFunction.Transpose(Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value) 'data starts in 2nd row
    ListB = Application.WorksheetFunction.Transpose(Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value) 'data starts in 2nd row
    ListC = Application.WorksheetFunction.Transpose(Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value) 'data starts in 2nd row
    ListD = Application.WorksheetFunction.Transpose(Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value) 'data starts in 2nd row
    ListE = Application.WorksheetFunction.Transpose(Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row).Value) 'data starts in 2nd row
    ListF = Application.WorksheetFunction.Transpose(Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row).Value) 'data starts in 2nd row
    ListG = Application.WorksheetFunction.Transpose(Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row).Value) 'data starts in 2nd row
    ListH = Application.WorksheetFunction.Transpose(Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row).Value) 'data starts in 2nd row
    ListI = Application.WorksheetFunction.Transpose(Range("I2:I" & Cells(Rows.Count, "I").End(xlUp).Row).Value) 'data starts in 2nd row
    ListJ = Application.WorksheetFunction.Transpose(Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row).Value) 'data starts in 2nd row

    Application.DisplayAlerts = False
    lnCounter = 2
    If (Sheet_Exists("Data") = True) Then
        Sheets("Data").Delete
    End If
    If (Sheet_Exists("Data") = False) Then
        Sheets.Add(After:=Sheets("ListDims")).Name = "Data"

    End If
    
    Set wsOutSheet = ThisWorkbook.Worksheets("Data")
    
    Sheets("ListDims").Select

   
    Range(Cells(1, lnStartcol), Cells(100000, lnStartcol + 10)).Select
    Range(Cells(1, lnStartcol), Cells(100000, lnStartcol + 10)).Clear
    
    Cells(1, lnStartcol) = Cells(1, 1)
    For i = 1 To lnNoOfDims
        Cells(1, lnStartcol + i) = Cells(1, 1 + i)
    Next i
    
    
    For a = 1 To UBound(ListA)
        For b = 1 To UBound(ListB)
            For c = 1 To UBound(ListC)
                For d = 1 To UBound(ListD)
                    For e = 1 To UBound(ListE)
                        For f = 1 To UBound(ListF)
                             For g = 1 To UBound(ListG)
                                For h = 1 To UBound(ListH)
                                    For i = 1 To UBound(ListI)
                                        For j = 1 To UBound(ListJ)
                                            Cells(lnCounter, lnStartcol) = ListA(a)
                                            Cells(lnCounter, lnStartcol + 1) = ListB(b)
                                            Cells(lnCounter, lnStartcol + 2) = ListC(c)
                                            Cells(lnCounter, lnStartcol + 3) = ListD(d)
                                            Cells(lnCounter, lnStartcol + 4) = ListE(e)
                                            Cells(lnCounter, lnStartcol + 5) = ListF(f)
                                            Cells(lnCounter, lnStartcol + 6) = ListG(g)
                                            Cells(lnCounter, lnStartcol + 7) = ListH(h)
                                            Cells(lnCounter, lnStartcol + 8) = ListI(i)
                                            Cells(lnCounter, lnStartcol + 9) = ListJ(j)
                                            
                                            'Generate a random value
                                            Cells(lnCounter, lnStartcol + 10) = WorksheetFunction.RandBetween(100, 9999)
                                            lnCounter = lnCounter + 1
                                        Next j
                                    Next i
                                Next h
                            Next g
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
    
    Application.CutCopyMode = False
    Selection.Copy
    
    Sheets("Data").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("ListDims").Select
    Selection.Clear
    Range("A1").Select
    Sheets("Data").Select
    Range("A1").Select
    Application.DisplayAlerts = True
    
End Sub
Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet

Sheet_Exists = False

For Each Work_sheet In ThisWorkbook.Worksheets

    If Work_sheet.Name = WorkSheet_Name Then
        Sheet_Exists = True
    End If

Next

End Function

Answer 1

我遇到的问题是，如果只有一个输入列只有 1 个项目，则 UBound() 会失败

因此，测试该条件并创建一个数组。

我建议将其包装到一个函数中

类似的东西

Function LoadArray(rng as Range) As Variant 
    Dim r as Range
    Dim arr As Variant 
    With Rng.EntireColumn
        Set r = Range( _
          .Cells(2, 1), _
          .Cells(.Worksheet.Rows.Count, 1).End(xlUp))
        If r.Cells.Count = 1 Then
            Redim arr(1 To 1)
            arr(1) = r.value2
            LoadArray = arr
        Else
            LoadArray = Application.Transpose(r.value2)
        EndIf
    End With
End Function 

并像这样使用它

LoadA = LoadArray(Cells(2, 1))

Answer 2

    ListA = Application.WorksheetFunction.Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value) 'data starts in 2nd row
    ListB = Application.WorksheetFunction.Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value) 'data starts in 2nd row
    ListC = Application.WorksheetFunction.Transpose(Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value) 'data starts in 2nd row
    ListD = Application.WorksheetFunction.Transpose(Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value) 'data starts in 2nd row
    ListE = Application.WorksheetFunction.Transpose(Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row).Value) 'data starts in 2nd row
    ListF = Application.WorksheetFunction.Transpose(Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row).Value) 'data starts in 2nd row
    ListG = Application.WorksheetFunction.Transpose(Range("G1:G" & Cells(Rows.Count, "G").End(xlUp).Row).Value) 'data starts in 2nd row
    ListH = Application.WorksheetFunction.Transpose(Range("H1:H" & Cells(Rows.Count, "H").End(xlUp).Row).Value) 'data starts in 2nd row
    ListI = Application.WorksheetFunction.Transpose(Range("I1:I" & Cells(Rows.Count, "I").End(xlUp).Row).Value) 'data starts in 2nd row
    ListJ = Application.WorksheetFunction.Transpose(Range("J1:J" & Cells(Rows.Count, "J").End(xlUp).Row).Value) 'data starts in 2nd row

    ...

    
    For a = 2 To UBound(ListA)
        For b = 2 To UBound(ListB)
            For c = 2 To UBound(ListC)
                For d = 2 To UBound(ListD)
                    For e = 2 To UBound(ListE)
                        For f = 2 To UBound(ListF)
                             For g = 2 To UBound(ListG)
                                For h = 2 To UBound(ListH)
                                    For i = 2 To UBound(ListI)
                                        For j = 2 To UBound(ListJ)