如何让Excel ListBox仅显示当日录入的条目？

问题背景 #

需要让Excel的ListBox仅展示当日录入的条目，当前录入的内容包含过往日期和当日日期，每次新增条目时过往日期的内容仍会显示，期望新增后ListBox只保留当日录入的颜色内容，无需按降序排列。现有代码如下：

Private Sub CommandButton1_Click()
    Dim Row As Long
    Row = ThisWorkbook.Sheets("ExcelEntryDB").Cells(Rows.Count, "A").End(xlUp).Row
    Me.ListBox1.ColumnCount = 3
    Me.ListBox1.ColumnHeads = True
    Me.ListBox1.ColumnWidths = "75;75;75"
    
    If Row > 1 Then
        Me.ListBox1.Rowsource = "ExcelEntryDB!C2:E" & Row
    Else
        Me.ListBox1.Rowsource = "ExcelEntryDB!C2:E2" & Row
    End If
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("ExcelEntryDB")
    Dim n As Long
    
    n = sh.Range("C" & Application.Rows.Count).End(xlUp).Row
    sh.Range("C" & n + 1).Value = Format(Date, "mm/dd/yyyy")
    sh.Range("D" & n + 1).Value = Format(Time, "hh:nn:ss AM/PM")
    sh.Range("E" & n + 1).Value = Me.TextBox3.Value
    
    Me.TextBox3.Value = ""
    
End Sub

你提到的判断日期等于当前日期，仅显示对应条目的逻辑完全可行，下面是修改后的完整代码，实现ListBox仅显示当日录入内容：

修改后的代码 #

Private Sub CommandButton1_Click()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("ExcelEntryDB")
    Dim n As Long, i As Long
    
    ' 新增条目到工作表（直接存日期/时间值，方便后续判断）
    n = sh.Range("C" & Application.Rows.Count).End(xlUp).Row
    sh.Range("C" & n + 1).Value = Date
    sh.Range("D" & n + 1).Value = Time
    sh.Range("E" & n + 1).Value = Me.TextBox3.Value
    
    Me.TextBox3.Value = ""
    
    ' 配置ListBox基础属性
    Me.ListBox1.ColumnCount = 3
    Me.ListBox1.ColumnWidths = "75;75;75"
    Me.ListBox1.Clear ' 清空原有内容
    
    ' 遍历数据，筛选当日条目添加到ListBox
    For i = 2 To sh.Range("C" & Application.Rows.Count).End(xlUp).Row
        ' 转换为日期值后和当前日期比较，避免格式差异导致判断错误
        If DateValue(sh.Range("C" & i).Value) = Date Then
            Me.ListBox1.AddItem
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Format(sh.Range("C" & i).Value, "mm/dd/yyyy")
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Format(sh.Range("D" & i).Value, "hh:nn:ss AM/PM")
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh.Range("E" & i).Value
        End If
    Next i
    
    ' 手动添加表头（使用AddItem时ColumnHeads属性不生效）
    Me.ListBox1.AddItem , 0 ' 在最上方插入空行
    Me.ListBox1.List(0, 0) = "日期"
    Me.ListBox1.List(0, 1) = "时间"
    Me.ListBox1.List(0, 2) = "颜色"
    Me.ListBox1.ListIndex = -1 ' 取消默认选中状态
End Sub

关键修改说明 #

• 日期存储优化：新增条目时直接存储Date和Time的原始值，而非格式化后的文本，避免后续日期比较时因格式不一致出现错误。
• 筛选逻辑实现：遍历工作表中的所有数据行，通过DateValue转换单元格值后和当前日期Date对比，仅将符合条件的条目添加到ListBox。
• 表头设置：因为使用AddItem方法时，ListBox的ColumnHeads=True属性不会生效，所以手动在ListBox最上方插入表头行。

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