Excel VBA提取成绩表数据至数组并写入Sheet2无结果问题求助

你的代码没报错但没得到预期结果，核心问题是未明确指定工作表的单元格引用，加上一些可优化的细节：

核心问题点 #

• 读取数据时，Cells(r, c).Value默认指向当前激活的工作表，而非目标的Sheet1，导致读入数组的可能是错误数据甚至空值。
• 变量lrow和lc用了Integer类型，Excel行数超过32767时会溢出，应该改用Long类型。
• 写入数据时用Select切换工作表不够可靠，直接指定工作表引用更稳定。

修复后的代码（保留原循环逻辑） #

Private Sub CommandButton1_Click()
    Dim myarr() As String
    Dim lrow As Long, lc As Long, r As Long, c As Long
    
    ' 明确指定Sheet1获取行列数
    lrow = Sheets("Sheet1").Range("A" & Sheets("Sheet1").Rows.Count).End(xlUp).Row
    lc = Sheets("Sheet1").Range("A1").End(xlToRight).Column
    
    ' 调整数组下界为1，和循环起始值匹配（更直观）
    ReDim myarr(1 To lrow, 1 To lc) As String
    
    ' 读取Sheet1数据到数组，明确指定工作表
    For r = 1 To lrow
        For c = 1 To lc
            myarr(r, c) = Sheets("Sheet1").Cells(r, c).Value
        Next c
    Next r
    
    ' 写入Sheet2，直接指定工作表，无需Select
    For r = 1 To lrow
        For c = 1 To lc
            Sheets("Sheet2").Cells(r, c) = myarr(r, c)
        Next c
    Next r
End Sub

更高效的优化版本（无需双重循环） #

VBA支持直接将单元格区域赋值给Variant数组，再批量写入目标区域，效率比循环高得多：

Private Sub CommandButton1_Click()
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim dataArr As Variant
    
    ' 获取Sheet1的完整数据源区域
    With Sheets("Sheet1")
        Set sourceRange = .Range("A1:" & .Cells(.Rows.Count, "A").End(xlUp).Address _
            & ":" & .Cells(1, .Columns.Count).End(xlToLeft).Address)
    End With
    
    ' 直接将区域数据存入数组
    dataArr = sourceRange.Value
    
    ' 获取Sheet2的目标区域，大小与数据源一致
    Set targetRange = Sheets("Sheet2").Range("A1").Resize(UBound(dataArr, 1), UBound(dataArr, 2))
    
    ' 批量写入数据
    targetRange.Value = dataArr
End Sub

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