如何编写Excel宏按日期筛选并提取指定评论数据？

以下是可直接使用的VBA代码，支持处理1000行数据，完全匹配你的需求：

Sub ExtractRowsWithTodayComments()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim todayDate As String
    Dim lastRow As Integer, targetRow As Integer
    Dim cell As Range, comment As Comment
    Dim hasTodayComment As Boolean
    Dim todayComments As String
    
    ' 设置源工作表和目标工作表名称，根据你的实际表格修改
    Set wsSource = ThisWorkbook.Worksheets("数据源")
    Set wsTarget = ThisWorkbook.Worksheets("提取结果")
    
    ' 清空目标工作表原有数据（保留表头，假设表头在第1行）
    wsTarget.Rows("2:" & wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 格式化当日日期，确保和评论中的日期格式一致（比如"2022/08/22"）
    todayDate = Format(Date, "yyyy/mm/dd")
    
    ' 初始化目标工作表的起始行（从第2行开始，跳过表头）
    targetRow = 2
    
    ' 遍历源工作表的1-1000行数据（假设数据从第2行开始，表头在第1行）
    For lastRow = 2 To 1001
        Set cell = wsSource.Cells(lastRow, "A") ' 假设评论在A列，根据实际列修改
        
        hasTodayComment = False
        todayComments = ""
        
        ' 检查当前单元格是否有评论
        If Not cell.Comment Is Nothing Then
            ' 拆分评论内容（假设评论是每行一个日期+内容的格式，比如"2022/08/22: 今日反馈"）
            ' 如果你的评论格式不同，需要调整拆分逻辑
            Dim commentLines As Variant
            commentLines = Split(cell.Comment.Text, vbCrLf)
            
            ' 逐个检查评论行
            Dim line As Variant
            For Each line In commentLines
                ' 判断当前行是否包含当日日期
                If InStr(1, line, todayDate, vbTextCompare) > 0 Then
                    hasTodayComment = True
                    ' 收集当日评论
                    If todayComments <> "" Then todayComments = todayComments & vbCrLf
                    todayComments = todayComments & line
                End If
            Next line
            
            ' 如果有当日评论，更新单元格评论为仅当日内容
            If hasTodayComment Then
                cell.Comment.Delete
                cell.AddComment todayComments
                ' 复制当前行到目标工作表
                wsSource.Rows(lastRow).Copy wsTarget.Rows(targetRow)
                targetRow = targetRow + 1
            End If
        End If
    Next lastRow
    
    MsgBox "处理完成！共提取 " & targetRow - 2 & " 行数据。"
End Sub

关键说明与调整点 #

• 工作表名称：代码中"数据源"和"提取结果"是示例名称，需要替换成你实际的工作表名。
• 评论列位置：假设评论在A列，若你的评论在其他列（比如B列），修改wsSource.Cells(lastRow, "A")中的"A"为对应列标。
• 评论格式适配：如果你的评论不是每行一个日期+内容的格式，需要调整Split(cell.Comment.Text, vbCrLf)的拆分规则。比如如果评论是用逗号分隔，就改成Split(cell.Comment.Text, ",")。
• 日期格式匹配：确保Format(Date, "yyyy/mm/dd")的格式和你评论中的日期格式完全一致，比如评论是"2022-08-22"，就改成Format(Date, "yyyy-mm-dd")。

使用方法 #

1. 打开你的Excel文件，按Alt + F11打开VBA编辑器。
2. 插入一个新模块：右键点击左侧工程窗口中的文件，选择「插入」→「模块」。
3. 将上述代码粘贴到模块中，根据你的实际情况调整参数。
4. 按F5运行宏，或者回到Excel界面，通过「开发工具」→「宏」选择并运行ExtractRowsWithTodayComments。

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