如何用Excel VBA/公式保留指定学生行并生成按日期展示的数据透视表？

我来给你分享两种实用的实现方案，分别用Excel VBA和公式+手动操作的组合来满足你的需求：

这个方案适合需要重复操作或者想一键完成的场景，代码会帮你自动保留选中行、删除其他行，然后生成按日期分组的数据透视表。

步骤1：准备代码 #

打开Excel，按下Alt + F11打开VBA编辑器，插入一个新模块，粘贴以下代码：

Sub KeepSelectedAndCreatePivot()
    Dim ws As Worksheet
    Dim selectedRows As Range
    Dim allRows As Range
    Dim pivotWs As Worksheet
    Dim cache As PivotCache
    Dim pivotTable As PivotTable
    
    ' 设置当前工作表（可根据实际修改Sheet名称）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取用户选中的行（确保选中的是整行或行内单元格）
    Set selectedRows = Intersect(ws.UsedRange, ws.Rows(ws.Selection.Row).EntireRow)
    
    ' 确认有选中行
    If selectedRows Is Nothing Then
        MsgBox "请先选中要保留的学生行！", vbExclamation
        Exit Sub
    End If
    
    ' 获取所有数据行（假设表头在第1行）
    Set allRows = ws.UsedRange.Offset(1).EntireRow
    
    ' 删除未选中的行
    Application.ScreenUpdating = False
    allRows.EntireRow.Hidden = True
    selectedRows.EntireRow.Hidden = False
    allRows.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = False
    allRows.SpecialCells(xlCellTypeHidden).EntireRow.Delete
    Application.ScreenUpdating = True
    
    ' 创建新工作表存放数据透视表
    On Error Resume Next
    Set pivotWs = ThisWorkbook.Worksheets("PivotResult")
    If Err.Number <> 0 Then
        Set pivotWs = ThisWorkbook.Worksheets.Add(After:=ws)
        pivotWs.Name = "PivotResult"
    End If
    On Error GoTo 0
    
    ' 创建数据透视表缓存
    Set cache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws.UsedRange)
    
    ' 创建数据透视表
    Set pivotTable = cache.CreatePivotTable(TableDestination:=pivotWs.Range("A3"), TableName:="StudentPivot")
    
    ' 设置透视表字段（假设日期列是第2列，其他数据列按需调整）
    With pivotTable
        ' 将日期字段拖到行区域
        .PivotFields("日期").Orientation = xlRowField
        .PivotFields("日期").Position = 1
        
        ' 将其他16列数据拖到值区域（这里循环添加，可根据实际列名修改）
        Dim i As Integer
        For i = 3 To ws.UsedRange.Columns.Count
            .AddDataField .PivotFields(ws.Cells(1, i).Value), ws.Cells(1, i).Value, xlSum ' 汇总方式可改为xlCount/xlAverage等
        Next i
    End With
    
    MsgBox "操作完成！已生成数据透视表。", vbInformation
End Sub

步骤2：代码说明 #

• 代码会先检查你是否选中了要保留的行，没选中会弹出提示
• 自动隐藏并删除未选中的行，只保留你选中的学生数据
• 自动创建新工作表生成透视表，把日期作为行标签，其他列作为值字段（汇总方式默认是求和，可根据需求修改xlSum为xlCount/xlAverage等）
• 注意修改代码中的工作表名称（比如Sheet1）和日期列的位置（如果你的日期不在第2列）

如果不想用VBA，适合Excel 365/2021版本（支持动态数组函数），可以先提取目标学生数据，再手动创建透视表。

步骤1：提取选中学生的数据 #

假设你的搜索结果在Sheet1，表头在第1行，选中的学生姓名在A2（可根据实际调整），在新工作表的A1单元格输入以下公式：

=FILTER(Sheet1!A:Q, (Sheet1!A:A=Sheet1!A2)*(Sheet1!B:B=Sheet1!B2))

这个公式会筛选出和选中学生名+姓完全匹配的所有行（如果有重名的话），自动生成动态数组结果。

步骤2：手动创建数据透视表 #

1. 选中公式生成的所有数据区域
2. 点击菜单栏的插入 -> 数据透视表
3. 在弹出的对话框中确认数据源，选择存放透视表的位置
4. 在透视表字段面板中，把日期字段拖到行区域，把其他16个字段拖到值区域，调整汇总方式即可

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