【excel】创建了一个日程表

最近感觉做事没有章法，列一个日程表，督促自己。

这里记录一下日程表的内容和一些操作。

内容

日期，显示年月日，周单独用一格展示，和年月日接着。

今日待办，分为事件和优先级，预留了六件事，这里考虑的是，人一天时间有限，能完成这六件事就很不错了。

临时新增，分为事件和优先级，也预留了六件事，和待办一样的想法，这里是做的补充，一般不会多于待办的事件数。

计划安排，分为时间、事件、内容，时间从 9 点开始，每半个小时为一项，到 23 点结束，一共28行。

执行情况，分为事件、完成情况、实际时间、总结。

优先级，紧急、高、中、低，对应颜色：rgb(239 68 68)、rgb(249 115 22)、rgb(59 130 246)、rgb(156 163 175)

状态，未开始、已完成、未完成

按照这个内容，实际使用了几天，感觉基本满足当初的构想了。

操作

这里记录一下用到的一些操作。

下拉框

0. [ 文件 ] -> [ 自定义功能区 ] -> [ 主选项卡 ] 勾选 [ 开发工具 ]，如果有开发工具可忽略这一步
1. 准备数据，我是在当前表，找了一个空位，写上了数据
2. 选择需要设置为下拉款的单元格
3. [ 数据 ] -> [ 数据验证 ] -> [ 设置 ] 验证条件中的 [ 允许 ] 下拉框中选择 [ 序列 ]
4. 页面会出现 [ 来源 ] 一项，点击输入框后面的按钮，选择之前准备好的数据

联动变色

1. 选择需要改变的所有单元格
2. [ 开始 ] -> [ 条件格式 ] -> [ 新建规则 ] -> [ 使用公式确定要设置格式的单元格 ]
3. 写公式，例如：=$B6="高"
4. [ 格式 ]，在格式中设置颜色，字体
5. [ 确定 ]

这里说明一下，框选范围后，写公式，excel 会自动帮我们运算。

在计划安排或执行情况中，事件为待办或新增的事件时，自动应用其颜色

这个时候需要用到宏，大概就是需要写代码，我直接让 AI 帮我写了一个，对整个文件生效

0. [ 文件 ] -> [ 自定义功能区 ] -> [ 主选项卡 ] 勾选 [ 开发工具 ]，如果有开发工具可忽略这一步
1. 在工作表的 tab 页签上右键，选择 [ 查看代码 ]
2. 因为是要对整个 excel 文件生效，双击 ThisWorkbook，在这里面写代码
3. 保存，会提醒需要保存为 xlsm 格式的文件，照做即可。

下面直接贴出代码，代码内容没有研究，下次如果要用，估计也是让 AI 帮我生成一份，这里就不细究了。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim watchRangeB As Range
    Dim watchRangeE As Range
    Dim affectedRange As Range
    
    ' === 配置监控区域 ===
    Set watchRangeB = Sh.Range("B15:B42")
    Set watchRangeE = Sh.Range("E15:E25")
    
    ' 判断触发区域
    If Not Intersect(Target, watchRangeB) Is Nothing Then
        Set affectedRange = Intersect(Target, watchRangeB)
        Call ProcessColorChange(Sh, affectedRange, "A:C")
    ElseIf Not Intersect(Target, watchRangeE) Is Nothing Then
        Set affectedRange = Intersect(Target, watchRangeE)
        Call ProcessColorChange(Sh, affectedRange, "E:G")
    Else
        Exit Sub
    End If
End Sub

' 独立处理颜色变化的子过程
Private Sub ProcessColorChange(Sh As Object, affectedRange As Range, targetCols As String)
    Dim cell As Range
    Dim lookupVal As String
    Dim foundCell As Range
    Dim sourceCell As Range
    Dim targetRow As Long
    Dim searchRangeA As Range
    Dim searchRangeD As Range
    
    ' 定义两个查找范围
    Set searchRangeA = Sh.Range("A6:A11")
    Set searchRangeD = Sh.Range("D6:D11")
    
    On Error GoTo ErrorHandler
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each cell In affectedRange
        lookupVal = Trim(CStr(cell.Value))
        targetRow = cell.Row
        
        ' 获取目标变色区域
        Dim targetRange As Range
        Set targetRange = Sh.Range(Replace(targetCols, ":", targetRow & ":") & targetRow)
        ' 上面这行逻辑有点问题，重新构建 targetRange
        Dim colStart As String
        Dim colEnd As String
        Dim pos As Integer
        pos = InStr(targetCols, ":")
        colStart = Left(targetCols, pos - 1)
        colEnd = Mid(targetCols, pos + 1)
        Set targetRange = Sh.Range(colStart & targetRow & ":" & colEnd & targetRow)
        
        If lookupVal = "" Then
            ' 清空时恢复默认
            With targetRange
                .Interior.ColorIndex = xlNone
                .Font.Color = vbBlack
                .Font.Bold = False
            End With
        Else
            ' 先在 A6:A11 中查找
            Set foundCell = searchRangeA.Find(What:=lookupVal, LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not foundCell Is Nothing Then
                ' 如果在A列找到，取同行 B列 (第2列) 的颜色
                Set sourceCell = Sh.Cells(foundCell.Row, 2)
            Else
                ' 如果A列没找到，再在 D6:D11 中查找
                Set foundCell = searchRangeD.Find(What:=lookupVal, LookIn:=xlValues, LookAt:=xlWhole)
                If Not foundCell Is Nothing Then
                    ' 如果在D列找到，取同行 E列 (第5列) 的颜色
                    ' 注意：如果您希望取D列本身的颜色，请将下面的 5 改为 4
                    Set sourceCell = Sh.Cells(foundCell.Row, 5)
                End If
            End If
            
            If Not foundCell Is Nothing Then
                ' 找到匹配项，应用颜色
                With targetRange
                    .Interior.Color = sourceCell.DisplayFormat.Interior.Color
                    .Font.Color = sourceCell.DisplayFormat.Font.Color
                    .Font.Bold = sourceCell.DisplayFormat.Font.Bold
                End With
            Else
                ' 两个范围都没找到，清除格式
                With targetRange
                    .Interior.ColorIndex = xlNone
                    .Font.Color = vbBlack
                    .Font.Bold = False
                End With
            End If
        End If
    Next cell

SafeExit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
    
ErrorHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

我是虚玩玩，与君共勉~