Mark Time Range


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub MarkTimeRange()
    Dim ws As Worksheet
    Dim startTime As String, endTime As String
    Dim taskName As String
    Dim colorRed As Integer, colorGreen As Integer, colorBlue As Integer
    Dim targetColumn As Long
    Dim startCell As Range, endCell As Range, cell As Range
    Dim selectedCell As Range
    
    ' 设置工作表
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 选择任务单元格（包含任务名称和填充颜色）
    On Error Resume Next
    Set selectedCell = Application.InputBox("请选择包含任务名称的单元格：", Type:=8)
    On Error GoTo 0

    If selectedCell Is Nothing Then
        MsgBox "未选择任务单元格。"
        Exit Sub
    End If

    ' 获取任务名称
    taskName = selectedCell.Value
    If taskName = "" Then
        MsgBox "所选单元格为空，请选择包含任务名称的单元格。"
        Exit Sub
    End If

    ' 获取颜色信息
    colorRed = selectedCell.Interior.Color Mod 256
    colorGreen = (selectedCell.Interior.Color \ 256) Mod 256
    colorBlue = (selectedCell.Interior.Color \ 65536) Mod 256

    ' 选择目标列
    Dim targetRange As Range
    On Error Resume Next
    Set targetRange = Application.InputBox("请选择要标记的列：", Type:=8)
    On Error GoTo 0

    If targetRange Is Nothing Then
        MsgBox "未选择目标列。"
        Exit Sub
    End If
    
    ' 获取目标列的列号
    targetColumn = targetRange.Column

    ' 获取时间范围
    startTime = InputBox("请输入开始时间（格式如 4:00）：")
    endTime = InputBox("请输入结束时间（格式如 10:30）：")

    ' 定位开始和结束时间对应的行
    Set startCell = ws.Columns(1).Find(What:=startTime, LookIn:=xlValues, LookAt:=xlWhole)
    Set endCell = ws.Columns(1).Find(What:=endTime, LookIn:=xlValues, LookAt:=xlWhole)

    If startCell Is Nothing Or endCell Is Nothing Then
        MsgBox "未找到对应的开始或结束时间，请检查输入格式。"
        Exit Sub
    End If

    ' 在首个标记单元格中写入任务名称并加粗
    ws.Cells(startCell.Row, targetColumn).Value = taskName
    ws.Cells(startCell.Row, targetColumn).Font.Bold = True

    ' 执行填充
    For Each cell In ws.Range(ws.Cells(startCell.Row, targetColumn), ws.Cells(endCell.Row, targetColumn))
        cell.Interior.Color = RGB(colorRed, colorGreen, colorBlue)
    Next cell

    MsgBox "任务时间段已成功标记。"
End Sub