Excel用户窗体保存前检测竖线分隔日期重复项并标记评论

核心思路 #

1. 遍历表格所有已有记录，将每个日期与其所在行号关联存入字典（键为日期字符串，值为对应行号的集合）
2. 拆分用户提交的新日期列表，逐个检查是否存在于字典中
3. 若发现重复，标记新记录的「评论」列为"Review"，同时将字典中对应行的「评论」列也标记为"Review"

完整VBA代码 #

Private Sub SaveButton_Click()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim dateDict As Object
    Dim existingDates As Variant
    Dim splitDates As Variant
    Dim dateStr As String
    Dim rowNum As Long
    Dim newDateStr As String
    Dim newRow As ListRow
    Dim hasDuplicate As Boolean
    
    ' 替换为你的工作表和表格名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set tbl = ws.ListObjects("DataTable")
    Set dateDict = CreateObject("Scripting.Dictionary")
    
    ' 构建已有日期与行号的映射字典
    For rowNum = 1 To tbl.ListRows.Count
        existingDates = Split(tbl.ListRows(rowNum).Range.Columns(tbl.ListColumns("已存储日期").Index).Value, "|")
        existingDates = Filter(existingDates, "", False) ' 过滤拆分产生的空值
        
        For Each dateStr In existingDates
            dateStr = Trim(dateStr)
            If dateDict.Exists(dateStr) Then
                dateDict(dateStr).Add rowNum
            Else
                Dim rowCol As New Collection
                rowCol.Add rowNum
                dateDict.Add dateStr, rowCol
            End If
        Next dateStr
    Next rowNum
    
    ' 获取用户提交的新日期并检查重复
    newDateStr = Me.txtNewDates.Text ' 替换为你的日期输入控件名称
    splitDates = Split(newDateStr, "|")
    splitDates = Filter(splitDates, "", False)
    
    hasDuplicate = False
    For Each dateStr In splitDates
        dateStr = Trim(dateStr)
        If dateDict.Exists(dateStr) Then
            hasDuplicate = True
            ' 标记所有包含该重复日期的已有行
            For Each rowNum In dateDict(dateStr)
                tbl.ListRows(rowNum).Range.Columns(tbl.ListColumns("评论").Index).Value = "Review"
            Next rowNum
        End If
    Next dateStr
    
    ' 添加新记录并标记评论
    Set newRow = tbl.ListRows.Add(AlwaysInsert:=True)
    newRow.Range.Columns(tbl.ListColumns("已存储日期").Index).Value = newDateStr
    If hasDuplicate Then
        newRow.Range.Columns(tbl.ListColumns("评论").Index).Value = "Review"
    End If
    
    ' 清理对象
    Set dateDict = Nothing
    Set tbl = Nothing
    Set ws = Nothing
    MsgBox "保存完成！", vbInformation
End Sub

关键细节说明 #

• 日期拆分过滤：用Filter函数去除Split竖线后产生的空元素，避免无效值干扰检测
• 字典存储逻辑：用集合存储同一日期对应的多个行号，确保所有重复行都能被标记
• 列定位方式：通过表格的ListColumns索引定位列，避免因列位置变动导致代码失效
• 空值处理：对日期字符串做Trim操作，防止空格导致的误判

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