请求实现VBA动态循环生成指定工作表固定区域数组的方案

问题背景 #

我正在为本地学校开发学生进度报告系统，用于家长会和学校报告场景，可简化教师收集、查看与维护数据的流程，大幅节省时间。当前需求为：每个学生对应独立工作表（数量可变），需将这些工作表的固定区域数据导出至Word文档。现有代码可正常运行，但其中的Get my Range Array部分为固定数组，需修改为动态实现：从第15张工作表开始，遍历至最后一张工作表（Sheets.Count），生成包含各工作表固定区域Sheet_x.Range("C141:C157")的动态数组，以便提取数据填充Word文档。

修改后的完整代码 #

Sub Word_Export()
'  Make 'Master Lists' Sheet visible ---------------------------------------------------------------
   Call Add_Child_Sheet
    
' Declare Word Variables ---------------------------------------------------------------------------
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    
' Declare Excel Variables --------------------------------------------------------------------------
    Dim Rng As Variant
    Dim ExlRng As Range
    Dim RngArray As Variant
    Dim SheetIndex As Integer ' 新增：用于遍历工作表索引
    Dim totalSheets As Integer ' 新增：计算需要处理的工作表总数

' Declare Report Variables -------------------------------------------------------------------------
    Dim Students As Integer
    Dim Counter As Integer
    Dim Student_Name As String

' Start up Preperation -----------------------------------------------------------------------------
    Application.EnableEvents = False
    Application.Calculation = False

' Open a new instance of Word ----------------------------------------------------------------------
    Set WordApp = New Word.Application
        WordApp.Visible = True
        WordApp.Activate

' Create a new document in Word Application --------------------------------------------------------
    Set WordDoc = WordApp.Documents.Add
        WordDoc.PageSetup.PaperSize = 9

' 动态生成Range数组  ----------------------------------------------------------------------------
    totalSheets = Sheets.Count - 14 ' 计算从第15张到最后一张的工作表数量
    ReDim RngArray(0 To totalSheets - 1) ' 初始化动态数组（VBA数组默认从0开始）
    
    For SheetIndex = 15 To Sheets.Count
        ' 将当前工作表的指定区域添加到数组中
        Set RngArray(SheetIndex - 15) = Sheets(SheetIndex).Range("C141:C157")
    Next SheetIndex

' Loop through each element in the range Array  ----------------------------------------------------
    For Each Rng In RngArray
    
    ' Create a reference to the range I want to copy -----------------------------------------------
        Set ExlRng = Rng
            ExlRng.Copy
    
    ' Pause Excel Application ----------------------------------------------------------------------
        Application.Wait Now() + #12:00:03 AM#
    
    ' With the current selection paste the Range ---------------------------------------------------
        With WordApp.Selection
            .Paste
            .Tables(1).AutoFitBehavior (wdAutoFitWindow)
        End With
        
    
    ' Set Margins in Word --------------------------------------------------------------------------
        With WordApp.ActiveDocument.PageSetup
            .TopMargin = WordApp.InchesToPoints(0.2)
            .BottomMargin = WordApp.InchesToPoints(0.2)
            .LeftMargin = WordApp.InchesToPoints(0.2)
            .RightMargin = WordApp.InchesToPoints(0.2)
        End With

    ' Create a New Page in Word --------------------------------------------------------------------
        WordApp.ActiveDocument.Sections.Add
        

    ' Go to the New Page in Word -------------------------------------------------------------------
        WordApp.Selection.Goto What:=wdGoToPage, Which:=wdGoToNext

    ' Clear the Clipboard --------------------------------------------------------------------------
        Application.CutCopyMode = False
    
    Next
' --------------------------------------------------------------------------------------------------
' Finish up  ---------------------------------------------------------------------------------------
    Sheets("Master Lists").Select
        Lock_Data
        Application.EnableEvents = True
        Application.Calculation = True
' --------------------------------------------------------------------------------------------------
End Sub

关键修改说明 #

• 新增SheetIndex变量用于遍历从15到Sheets.Count的工作表索引
• 计算需要处理的工作表总数totalSheets = Sheets.Count - 14，因为第15张是起始点，总数等于总表数减去前14张
• 使用ReDim初始化动态数组，数组大小对应实际需要处理的工作表数量
• 通过循环将每个目标工作表的C141:C157区域对象存入数组，SheetIndex - 15用于匹配数组的0起始索引

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