时间戳

首页 > 解决方案 > VBA 循环填充数组

arrays - VBA 循环填充数组

问题描述

我正在考虑根据原始 Excel 表中的列填充数组。我试图循环遍历以迭代地获取每个字段组合，以便随后填充到第二个 Excel 表中。到目前为止，我已经填充了 5 个单独的数组，并获得了其中的数据计数，但是当我尝试填充遇到问题的“calcarray”时。执行时出现运行时错误“9”下标超出“calcarray（x，4）= Data5（d）”的范围任何帮助将不胜感激！

Sub populate_table()

Dim Data1() As Variant
Dim Data2() As Variant
Dim Data3() As Variant
Dim Data4() As Variant
Dim Data5() As Variant

Dim Data1Count As Integer
Dim Data2count As Integer
Dim Data3Count As Integer
Dim Data4Count As Integer
Dim Data5Count As Integer

Dim ttl As Long

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim f As Integer
Dim d As Integer

Dim tbl As ListObject
Set tbl = Sheets("Data").ListObjects("tbl_variables")

Data1Count = tbl.ListColumns("Data1").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data2count = tbl.ListColumns("Data2").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data3Count = tbl.ListColumns("Data3").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data4Count = tbl.ListColumns("Data4").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data5Count = tbl.ListColumns("Data5").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count

Data1 = Array(tbl.ListColumns("Data1").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data2 = Array(tbl.ListColumns("Data2").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data3 = Array(tbl.ListColumns("Data3").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data4 = Array(tbl.ListColumns("Data4").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data5 = Array(tbl.ListColumns("Data5").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)

ttl = (Data1Count) * (Data2count) * (Data3Count) * (Data4Count) * (Data5Count)

Dim calcarray() As Variant
ReDim calcarray(ttl, 4)

x = 0
For i = 0 To Data1Count
    For j = 0 To Data2count
        For k = 0 To Data3Count
            For f = 0 To Data4Count
                For d = 0 To Data5Count
                        calcarray(x, 0) = Data1(i)
                        calcarray(x, 1) = Data2(j)
                        calcarray(x, 2) = Data3(k)
                        calcarray(x, 3) = Data4(f)
                        calcarray(x, 4) = Data5(d)
                        x = x + 1
                Next
            Next
        Next
    Next
Next

标签： arraysexcelvbaloops

解决方案

您无法可靠地获得Value多区域范围的属性，如果可以，则无法将其包装Array()以获取可以通过循环中的索引进行循环的数组For...Next。如果您对阵列进行观察，您会发现它们可能与您预期的不同。

这是使用函数将表格列范围转换为值数组的一个建议：

Sub populate_table()

    Dim d1, d2, d3, d4, d5
    Dim ttl As Long, x As Long
    Dim i As Long, j As Long, k As Long, f As Long, d As Long
    
    With Sheets("Data").ListObjects("tbl_variables")
        d1 = VisibleCellsArray(.ListColumns("Data1").DataBodyRange) 'see function below
        d2 = VisibleCellsArray(.ListColumns("Data2").DataBodyRange)
        d3 = VisibleCellsArray(.ListColumns("Data3").DataBodyRange)
        d4 = VisibleCellsArray(.ListColumns("Data4").DataBodyRange)
        d5 = VisibleCellsArray(.ListColumns("Data5").DataBodyRange)
    End With
    
    Dim calcarray() As Variant
    ttl = UBound(d1) * UBound(d2) * UBound(d3) * UBound(d4) * UBound(d5)
    ReDim calcarray(1 To ttl, 1 To 5)
    
    x = 1
    For i = 1 To UBound(d1)
        For j = 1 To UBound(d2)
            For k = 1 To UBound(d3)
                For f = 1 To UBound(d4)
                    For d = 1 To UBound(d5)
                            calcarray(x, 1) = d1(i)
                            calcarray(x, 2) = d2(j)
                            calcarray(x, 3) = d3(k)
                            calcarray(x, 4) = d4(f)
                            calcarray(x, 5) = d5(d)
                            x = x + 1
                    Next
                Next
            Next
        Next
    Next
    
    'put on a sheet...
    Sheets("Data").Range("H2").Resize(ttl, 5).Value = calcarray

End Sub

'given a (single-row or -column) range
'  return a 1-based array of the visible cell values
Function VisibleCellsArray(rng As Range)
    Dim rngV As Range, c As Range, rv, i As Long
    Set rngV = rng.SpecialCells(xlCellTypeVisible)
    ReDim rv(1 To rngV.Cells.Count)
    i = 0
    For Each c In rngV.Cells
        i = i + 1
        rv(i) = c.Value
    Next c
    VisibleCellsArray = rv
End Function

推荐阅读