在带有 AND 和 OR 的 Do Until 循环中，即使它不满足两个 AND 语句，它也不会执行 OR

Question

我正在尝试编写一个可以在组内组织某些内容的代码。

例如，我在同一日期有很多活动，我想按位置进一步对它们进行分组。因此，当我插入一个新事件时，我需要一个宏，将其与当天的其他事件分组，但进一步将其与当天同一位置的事件分组。

希望这是有道理的。

我正在使用以下代码，但它会将事件分组到相同位置但不是同一天，即使我设置了循环，这样如果事件有正确的日期和正确的位置或继续查找，它就会停止穿过纸张的其余部分。

如有任何帮助，我们将不胜感激。

Event Name,        Location,       Date,
Event 1           LA             1/4/2025, 6:00AM
Event 2           LA             1/5/2025, 6:00AM
Event 3           LA             1/4/2025, 6:00AM

代码的工作方式是获取事件 3 并将其保留在事件 2 下，因为它看到事件 2 位于洛杉矶，而我实际上希望将其放在事件 1 下，因为它具有相同的日期和位置。

    'Organizes the events by date
    b = unusedRow - 1
    Do Until Range("I" & b).Value <= Range("I" & unusedRow).Value
        b = b - 1
    Loop

    'Checks if there are other events on the same day at the same location and groups those together
    c = unusedRow - 1
    Do Until c = 4 Or Range("I" & c).Value <= Range("I" & unusedRow).Value And Range("F" & c).Value = Range("F" & unusedRow).Value
        c = c - 1
    Loop
    
    'If there are no events with the same day and location (c=4) just put it with all the events on that day   
    If c = 4 Then
        Rows(unusedRow).Cut
        Rows(b + 3).Insert
    'If there are events with that day and location (c does not equal 4) then it groups it with them 
    Else
        Rows(unusedRow).Cut
        Rows(c + 1).Insert
    End If

Answer 1

Option Explicit

Sub reorder()
   Const FIRST_ROW = 4

   Dim newrow As Long, dt As Date, dtNew As Date
   Dim i As Long, r As Long
   Dim locn As String, locnNew As String
   
   With Sheet1
       
       ' find last row
        newrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        locnNew = .Cells(newrow, "F")
        dtNew = .Cells(newrow, "I")
         
        ' scan up the sheet
        i = FIRST_ROW
        For r = newrow - 1 To FIRST_ROW Step -1
        
            locn = .Cells(r, "F")
            dt = .Cells(r, "I")

            ' first match
            If (dt < dtNew) Or _
               ((dt = dtNew) And (locn = locnNew)) Then
                i = r + 1
                Exit For
            End If
        Next
       
        ' move row
        If i <> newrow Then
            .Rows(newrow).Cut
            .Rows(i).Insert
        Else
            MsgBox "No change"
        End If
        
    End With

End Sub