Excel宏开发求助：从学生费主表生成A生转置个人报表

需求说明 #

现有学生费主表，需通过宏在独立工作表生成学生A的个人报表：

• 仅保留Date、Class、Fee Tuition、Fee Exam列
• 数据需转置，不包含主表全部列
  当前宏已能遍历主表并识别学生A的行，需完善后续逻辑。

现有宏代码 #

Set MasterSheet = ThisWorkbook.Worksheets("Master")
Set TargetSheet = ThisWorkbook.Worksheets("StudentA")
LastRow = MasterSheet.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
    If MasterSheet.Range("B" & i).Value = "A" Then 'B column has names
        lastColumn = MasterSheet.Cells(1, MasterSheet.Columns.Count).End(xlToLeft).Column
        For j = 1 To lastColumn
        
        Next j
    End If
Next i

解决方案 #

核心思路 #

1. 先定位主表中需要保留的4列的列号，避免无效遍历
2. 提取学生A对应行的目标列数据，转置后写入目标工作表
3. 自动清理目标表旧数据，保证报表整洁

完整优化后代码 #

Sub GenerateStudentAReport()
    Set MasterSheet = ThisWorkbook.Worksheets("Master")
    Set TargetSheet = ThisWorkbook.Worksheets("StudentA")
    LastRow = MasterSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 清理目标表原有数据（表头除外）
    TargetSheet.Range("2:" & TargetSheet.Rows.Count).ClearContents
    
    ' 定义需要保留的列名
    Dim targetCols As Variant
    targetCols = Array("Date", "Class", "Fee Tuition", "Fee Exam")
    Dim colIndex As Variant, colNum As Integer
    Dim colDict As Object
    Set colDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历表头，存储目标列的列号
    Dim lastColumn As Integer
    lastColumn = MasterSheet.Cells(1, MasterSheet.Columns.Count).End(xlToLeft).Column
    For colNum = 1 To lastColumn
        For Each colIndex In targetCols
            If MasterSheet.Cells(1, colNum).Value = colIndex Then
                colDict(colIndex) = colNum
                Exit For
            End If
        Next colIndex
    Next colNum
    
    ' 写入转置后的表头到目标表
    TargetSheet.Cells(1, 1).Resize(UBound(targetCols) + 1, 1).Value = Application.Transpose(targetCols)
    
    ' 遍历主表，提取学生A的数据并转置写入
    Dim writeRow As Integer
    writeRow = 2 ' 表头在第1行，从第2行开始写入数据
    Dim i As Integer
    For i = 2 To LastRow
        If MasterSheet.Range("B" & i).Value = "A" Then
            ' 提取当前行的目标列数据
            Dim dataRange As Range
            Set dataRange = MasterSheet.Range( _
                MasterSheet.Cells(i, colDict("Date")), _
                MasterSheet.Cells(i, colDict("Fee Exam")) _
            )
            ' 转置后写入目标表，每组数据占4行
            TargetSheet.Cells(writeRow, 1).Resize(UBound(targetCols) + 1, 1).Value = Application.Transpose(dataRange.Value)
            ' 更新下一组数据的写入行号
            writeRow = writeRow + UBound(targetCols) + 1
        End If
    Next i
End Sub

代码说明 #

• 用字典colDict存储目标列的列号，精准定位数据列，避免遍历全部列，提升运行效率
• 自动清理目标表旧数据，防止重复生成报表导致数据混乱
• 数据转置为垂直排列，符合个人报表的阅读习惯
• 表头同步转置，和数据格式统一

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