如何将工作表中的数据填充到2D数组中

Question

如果我在工作表中填写了如图所示的数据，我想创建一个2D数组并用图像中所选单元格的数据填充它，即取第一个值并跳过下两个值依此类推，直到数组的末尾，并以相同的方式在列

中

我做了一个删除中间行和列的解决方案，但是对于大型数组（1000 * 1000的示例），需要花费大量时间才能以另一种方式创建具有上述条件的数组。 这是我用来删除中间行和列的代码：

Sub Sorting() 
Dim LastRow As Long
LastRow = sh.Range("A1", sh.Range("A1").End(xlDown)).rows.count 
For cntr = 1 To LastRow / 3 
rows(cntr + 1 & ":" & cntr + 2).EntireRow.Delete 
Next
Dim LastColumn As Long 
LastColumn = sh.Range("A1").CurrentRegion.Columns.count
K = LastColumn 
For cntr = 1 To K / 3 
Columns(cntr + 1).EntireColumn.Delete
Columns(cntr + 1).EntireColumn.Delete 
Next
End Sub enter code here 

Answer 1

这样的事情对你有用：

Sub tgr()

    Dim ws As Worksheet
    Dim aData As Variant
    Dim aResults() As Variant
    Dim lRow As Long, lCol As Long
    Dim i As Long, j As Long
    Dim lRowInterval As Long
    Dim lColInterval As Long

    Set ws = ActiveWorkbook.ActiveSheet
    lRowInterval = 3
    lColInterval = 3

    aData = ws.Range("A1").CurrentRegion
    ReDim aResults(1 To Int(UBound(aData, 1) / lRowInterval), 1 To Int(UBound(aData, 2) / lColInterval))

    i = 0
    For lRow = 1 To UBound(aData, 1) Step lRowInterval
        i = i + 1
        j = 0
        For lCol = 1 To UBound(aData, 2) Step lColInterval
            j = j + 1
            aResults(i, j) = aData(lRow, lCol)
        Next lCol
    Next lRow

    'Do what you want with the array aResults here

End Sub