Excel 如果发生冲突，则将单元格变为红色

我正试图用彩色编码来防止一个房间被双重预订

房间ID列包含重复项，没有顺序。行中的橙色单元格显示房间的预定日期，如下图所示：

---

---

我想要的是，如果同一天在同一个房间有另一个预订，手机就会变成红色。例如，如果A组预订了10月14日至16日，然后B组预订了10月16日至18日，我希望14日至15日和17日至18日标记为橙色，16日标记为红色表示双重预订

我修改了从另一篇文章中获得的一些代码，但它似乎只检查/引用了第一个重复的房间ID，这意味着只要该房间和日期只有两次预订，它就会将双人预订标记为红色，如果有更多，则不会将其计为双人预订

Sub Tester()

    Dim lastRow As Long
    Dim sht As Worksheet, rng As Range
    Dim dict As Object, dict2 As Object, v, c As Range, c2 As Range
    Dim FindFirstOrangeCell As Integer, FindEndOfOrangeCell As Integer
    Dim p As Long, l As Variant, AddOne As Integer, z As String

    For d = 0 To 10
        Set dict = CreateObject("scripting.dictionary")
        Set dict2 = CreateObject("scripting.dictionary")
        With Sheets("Schedule")
            Set rng = .Range("D2:D" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        End With

        For Each c In rng.Cells
            v = c.Value
            FindFirstOrangeCell = 1
            If Len(v) > 0 Then
                Do Until c.Offset(, FindFirstOrangeCell).Interior.ColorIndex = 44 Or c.Offset(, FindFirstOrangeCell).Interior.ColorIndex = xlColorIndexNone
                    FindFirstOrangeCell = FindFirstOrangeCell + 1
                Loop

            End If
            Set c2 = c.Offset(0, FindFirstOrangeCell)
            If Len(v) > 0 Then
                If c2.Interior.ColorIndex = 44 Or c2.Interior.ColorIndex = 3 Then
                    FindEndOfOrangeCell = 1
                    Do Until c2.Offset(, FindEndOfOrangeCell).Interior.ColorIndex = 4
                        FindEndOfOrangeCell = FindEndOfOrangeCell + 1
                    Loop

                    If dict.exists(v) Then
                        If dict2.exists(dict(v)) Then
                            If Not dict2(dict(v)) Is Nothing Then

                                 For p = 0 To FindEndOfOrangeCell - 1
                                    Cells(1, dict2(dict(v)).Column).Select
                                     If Cells(1, dict2(dict(v)).Column) = Cells(1, c2.Column + p) Then
                                         dict2(dict(v)).Interior.ColorIndex = 3
                                         Cells(c2.Row, c2.Column + p).Interior.ColorIndex = 3
                                     End If

                                     If Cells(1, dict2(dict(v)).Column + p) = Cells(1, c2.Column + AddOne) Then
                                         Cells(dict2(dict(v)).Row, dict2(dict(v)).Column + p).Interior.ColorIndex = 3
                                         Cells(c2.Row, c2.Column + AddOne).Interior.ColorIndex = 3
                                         AddOne = AddOne + 1
                                     End If
                                 Next p
                                 p = 0
                                 AddOne = 0
                            End If
                        End If
                    Else
                        Set dict(v) = c2
                        Set dict2(dict(v)) = c2
                    End If
                End If
            End If
        Next c
    Next d

End Sub

我是VBA新手，所以如果您看到任何降低我的代码速度或使其看起来不好的错误做法，请告诉我如何改进

我也在另一个论坛上发布了这个问题

---

是一个帮助理解数据的示例文件。

我试图在您的代码中找到问题，但最终我只是重写了它，正如您在下面看到的那样

我知道其中一个问题是你试图从哪里得到一系列的房间号码。您使用了以合并单元格结尾的第一列，当VBA运行到这些单元格中时，它将采用左上角的单元格引用，这将在检查中删除工作表的最后两行

Public Sub Tester()

    Dim roomRange As Range
    Dim roomCell As Range
    Dim roomNum As Long
    Dim bookingStart As Long
    Dim bookingEnd As Long
    Dim bookingRange As Range
    Dim bookingCell As Range
    Dim bookingDict As Object
    Set bookingDict = CreateObject("Scripting.Dictionary")
    Dim cellColour As Long

    With Sheets("Schedule") 'Get all room numbers
        Set roomRange = .Range("C2:C" & .Cells(.Rows.Count, 3).End(xlUp).Row)
    End With

    For Each roomCell In roomRange.Cells
        roomNum = roomCell.Value
        If Len(roomNum) > 0 Then

            'Find where booking starts
            bookingStart = 1
            cellColour = roomCell.Offset(0, bookingStart).Interior.ColorIndex
            Do Until cellColour = 44 Or cellColour = xlColorIndexNone Or cellColour = 3
                bookingStart = bookingStart + 1
                cellColour = roomCell.Offset(0, bookingStart).Interior.ColorIndex
            Loop

            'If there was a booking start
            If cellColour <> xlColorIndexNone Then
                'Find where booking ends
                bookingEnd = bookingStart
                cellColour = roomCell.Offset(0, bookingEnd + 1).Interior.ColorIndex
                Do Until cellColour <> 44 And cellColour <> 3
                    bookingEnd = bookingEnd + 1
                    cellColour = roomCell.Offset(0, bookingEnd + 1).Interior.ColorIndex
                Loop

                'Get booking cells
                Set bookingRange = Range(Cells(roomCell.Row, bookingStart + 3), Cells(roomCell.Row, bookingEnd + 3))
                For Each bookingCell In bookingRange.Cells

                    'If room already booked
                    If bookingDict.exists(roomNum & bookingCell.Column) Then
                        bookingCell.Interior.ColorIndex = 3
                        bookingDict(roomNum & bookingCell.Column).Interior.ColorIndex = 3
                    Else 'If this is the first booking
                        bookingDict.Add roomNum & bookingCell.Column, bookingCell
                    End If

                Next bookingCell
            End If
        End If
    Next roomCell
End Sub

公共子测试仪（）
昏暗的房间范围
昏暗的房间单元作为射程
暗淡的房间数和长的一样
暗淡的预订开始一样长
昏暗的书呆滞得一样长
昏暗的书房如射程
暗淡的bookingCell作为范围
作为对象的Dim bookingDict
Set bookingDict=CreateObject（“Scripting.Dictionary”）
暗淡的细胞颜色和长的一样
带床单（“时间表”）“获取所有房间号
设置roomRange=.Range（“C2:C”和.Cells（.Rows.Count，3）.End（xlUp）.Row）
以
对于roomRange.Cells中的每个roomCell
roomNum=roomCell.Value
如果Len（roomNum）>0，则
“找到预订的起点
bookingStart=1
CellColor=roomCell.Offset（0，bookingStart）.Interior.ColorIndex
直到CellColor=44或CellColor=xlColorIndexNone或CellColor=3
bookingStart=bookingStart+1
CellColor=roomCell.Offset（0，bookingStart）.Interior.ColorIndex
环
“如果有预订开始的话
如果CellColor xlColorIndexNone，则
“找到预订的终点
bookingEnd=bookingStart
CellColor=roomCell.Offset（0，Bookingand+1）。Interior.ColorIndex
直到CellColor 44和CellColor 3
bookingEnd=bookingEnd+1
CellColor=roomCell.Offset（0，Bookingand+1）。Interior.ColorIndex
环
“获取预订手机
设置bookingRange=范围（单元格（roomCell.Row，bookingStart+3）、单元格（roomCell.Row，bookingEnd+3））
对于bookingRange.Cells中的每个bookingCell
“如果房间已经预订了
如果bookingDict.存在（roomNum&bookingCell.Column），则
bookingCell.Interior.ColorIndex=3
bookingDict（roomNum&bookingCell.Column）.Interior.ColorIndex=3
如果这是第一次预订
bookingDict.添加roomNum和bookingCell.列，bookingCell
如果结束
下一个预订单元
如果结束
如果结束
下一个房间
端接头

---

如果您对它有任何进一步的问题，请给我留言，我会回复您。

如果有任何建议可以使我的代码看起来更整洁或运行更快，这里不是询问此问题的合适地方。我投票结束这个问题，因为如果这个代码有效并且没有实际问题（没有错误），最好在codereview.stackexchange.com问这个问题不确定你的问题是什么？你的代码有效吗？你只是想得到关于如何使它“更好”的建议吗？或者，除了性能问题之外，您的代码是否存在其他问题？我的代码没有按照我希望的方式工作，因为该程序仅使用第一个引用来检查所有日期，例如，如果第三排的房间ID 511在10月17日至19日期间被占用，而房间ID 511在10月14日至16日占用了另外两个数据，另外两个数据不会变为红色，因为他们在10月17日至19日检查单元格。获取建议不是我的主要问题，而是对代码的额外帮助。很抱歉，如果我对问题和我的描述不清楚。示例文件的链接无效，你有其他链接吗？嗨，你能访问这个吗？非常感谢您的帮助，您甚至评论了每段代码的作用，以帮助我理解每一部分。