如何用VBA将Excel选中单元格数值存入对应位置的二维数组

工作表部分单元格包含数字或文本，多数为空，结构示例如下：

需要生成满足以下要求的二维数组：

• 数组大小对应包含数字或文本的整个矩形范围（示例中为A1:D3）
• 仅保留数值（示例中的999、56、12），其余位置为Empty
• 数组中数值的索引与工作表中的位置一致，最终数组结构如下：

arr(0, 0) = Empty
arr(0, 1) = 999
arr(0, 2) = Empty
arr(0, 3) = Empty
arr(1, 0) = 56
arr(1, 1) = Empty
arr(1, 2) = Empty
arr(1, 3) = 12
arr(2, 0) = Empty
arr(2, 1) = Empty
arr(2, 2) = Empty
arr(2, 3) = Empty

已完成步骤 #

1. 识别包含内容的最后行列（可正常运行）：

lastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
lastCol = ws.Cells.SpecialCells(xlCellTypeLastCell).Column

2. 选中所有数值单元格（可正常运行）：

Set rg = ws.Range(Cells(1, 1), Cells(lastRow, lastCol)).SpecialCells(xlCellTypeConstants, xlNumbers)
rg.Select

3. 填充数组部分无法完成，寻求解决方法。

解决方案 #

以下是实现需求的完整VBA代码：

Sub GetTargetArray()
    Dim ws As Worksheet
    Set ws = ActiveSheet ' 可替换为指定工作表，如ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取包含内容的最后行列
    Dim lastRow As Long, lastCol As Long
    lastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
    lastCol = ws.Cells.SpecialCells(xlCellTypeLastCell).Column
    
    ' 初始化0开头的二维数组，对应工作表范围
    Dim arr() As Variant
    ReDim arr(0 To lastRow - 1, 0 To lastCol - 1)
    
    ' 获取所有数值单元格，添加错误处理防止无数值时出错
    Dim rg As Range, cell As Range
    On Error Resume Next
    Set rg = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).SpecialCells(xlCellTypeConstants, xlNumbers)
    On Error GoTo 0
    
    ' 遍历数值单元格，填充到对应数组位置
    If Not rg Is Nothing Then
        For Each cell In rg
            arr(cell.Row - 1, cell.Column - 1) = cell.Value
        Next cell
    End If
    
    ' 可选：在立即窗口打印数组内容验证结果
    Dim i As Long, j As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            Debug.Print "arr(" & i & ", " & j & ") = " & IIf(IsEmpty(arr(i, j)), "Empty", arr(i, j))
        Next j
    Next i
End Sub

代码说明 #

• 数组初始化时通过ReDim指定0起始索引，对应工作表1起始的行列，因此行号和列号都减1
• 遍历每个数值单元格，将单元格值赋值到数组对应的索引位置
• 添加On Error Resume Next处理无数值单元格的情况，避免代码报错
• 可选的打印代码可在VBA编辑器的立即窗口查看生成的数组结构，验证结果是否符合要求

内容的提问来源于stack exchange，提问作者Maksim