Excel 在VBa中迭代行时，如何使带有If语句的For循环更有效？

我有一个嵌套在另一个For循环中的For循环，它迭代电子表格中的每一行

下面的嵌套for循环检查当前行，然后在电子表格中的每一行上循环，以查看它是否符合if语句条件。如果是，它将bool更改为True并退出嵌套循环

这种方法花费的时间太长。电子表格是1000行x27列，在我使用的小型PC上运行将花费很长时间

守则：

    Sub Check_Errors()
    Dim x As Integer
    Dim lastRow As Long
    Dim duplicateData As Boolean

    Set Data = ThisWorkbook.Sheets("Data") 'Worksheet with Raw data
    Set Errors = ThisWorkbook.Sheets("Errors") 'Where any flagged rows are copied to.

    x = 2
    lastRow = Data.Cells(Data.Rows.Count, "A").End(xlUp).Row
    duplicateData = False

'Copies the headings from Data worksheet to Error worksheet
    For j = 1 To 26
        Errors.Cells(1, j).Value = Data.Cells(1, j).Value
    Next j

    Errors.Cells(1, 27).Value = "Error Type"

    For i = 2 To lastRow

        wrongSpeciality = False



            For j = 2 To 300
                If ((Data.Cells(i, 19) < Data.Cells(j, 19) + (Data.Cells(j, 20) / 1440) + (Data.Cells(j, 21) / 1440) _
                And Data.Cells(i, 19) >= Data.Cells(j, 19)) _
                Or _
                (Data.Cells(i, 19) + (Data.Cells(i, 20) / 1440) + (Data.Cells(i, 21) / 1440) <= Data.Cells(j, 19) + (Data.Cells(j, 20) / 1440) + (Data.Cells(j, 21) / 1440) _
                And Data.Cells(i, 19) + (Data.Cells(i, 20) / 1440) + (Data.Cells(i, 21) / 1440) > Data.Cells(j, 19))) _
         _
                And Data.Cells(i, 18) = Data.Cells(j, 18) _
                And Data.Cells(i, 22) = Data.Cells(j, 22) _
                And Not i = j Then

                    duplicateData = True
                    Exit For

                End If
            Next j

'If true then copy flagged row to Error worksheet and add additional column with reason row was flagged.   
        If duplicateData Then

            For j = 1 To 26
                Errors.Cells(x, j).Value = Data.Cells(i, j).Value
            Next j
            Errors.Cells(x, 27).Value = "Time overlapping"
            x = x + 1
        End If

    Next i

---

值得注意的是，完成时间可以与开始时间相同，因此James可以在11:00看到患者，11:30完成，下一个患者的开始时间为11:30，而无需标记这两个时间。

想象以下数据：

按以下两种方式进行排序：

第五栏临床医生A…Z 而W列开始低…高 我添加了3列W、X和Y，您可以使用其他列。公式如下：

W:=R:R+S:S列将开始日期和时间相加 X列：=R:R+S:S+T:T/1440+U:U/1440计算结束日期/时间

---

Y2并向下复制：=IFANDV2=V1，w2将excel工作表中的数据存储到和数组中，然后使用该数组。这将要快得多：如果您期望的注释多于该注释，那么您应该包含相关代码，因为它是不完整的。始终包括变量的声明/初始化。谢谢@Pᴇʜ. 希望我现在提供的代码能进一步帮助您。数据是按这些列中的任何一列排序的吗？如果有的话，由谁来决定？我们可以把它分类吗？如果我们能够假设排序后的数据，这将有助于开发更好的算法。@Pᴇʜ数据可以按任何顺序排序！我更喜欢在Vba中使用它，因为循环会检查复制到错误工作表中的其他条件。我对数组还不是很有信心，所以这是一个学习和实现的完美答案。非常感谢！我会报告我自己何时以及是否能让它成功运行。事实上，使用值数组非常简单，就像使用Cellsrow和column一样。如果将数据读入arr=RangeA1:B10.Value这样的数组，则可以像使用单元格一样使用arrrow、column。数组的优点是它们的速度快得多，因为它们只包含值，而单元格也包含格式化内容等。如果有If arrDataiRow，1=arrDataiRow，1不应该是If arrDataiRow，1=arrDataiRow+1，1，否则它会检查它是否与自身相同？@WillacyMe ehm是的，当然这是错误的。但它必须是-1 arrDataiRow-1，1，因为它需要与前一行进行比较，而不是与下一行进行比较。它必须始终将实际行iRow与前一行中的数据进行比较！另一个值得一提的注意事项是，如果15/02/18 15:00添加了半小时的活动，并将其与另一行的开始日期/时间为15/02/18 15:30进行比较，excel将认为这两个日期不同。通过使用If DateDiffs PreviousEndDate，StartDate=0纠正了这一点

Columns 18        19     20             21            22
        Date      Time   ClinicalTime   AdminTime     Clinician
        12/01/18  13:00  20             10            James
        12/01/18  13:25  10             20            James
        12/01/18  14:30  40              0            James
        14/01/18  10:00  20             20            Samantha 

Option Explicit

Public Sub CheckForOverlappings()
    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Data")

    Dim wsErrors As Worksheet
    Set wsErrors = ThisWorkbook.Worksheets("Errors")

    Dim LastDataRow As Long
    LastDataRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

    Dim LastErrorRow As Long
    LastErrorRow = 2

    'sort data by …
    With wsData.Sort
        .SortFields.Clear
        '… field Clinician
        .SortFields.Add2 Key:=Range("V2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        '… field Date
        .SortFields.Add2 Key:=Range("R2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        '… field Time
        .SortFields.Add2 Key:=Range("S2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        .SetRange Range("1:" & LastDataRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    'write headers for error sheet
    wsErrors.Cells(1, 1).Resize(ColumnSize:=26).Value = wsData.Cells(1, 1).Resize(ColumnSize:=26).Value
    wsErrors.Cells(1, 27).Value = "Error Type"

    'read relevant data into array
    Dim arrData As Variant
    arrData = wsData.Range(wsData.Cells(1, 18), wsData.Cells(LastDataRow, 22))

    'initialize start/enddate with first data row (= row 2)
    Dim StartDate As Date
    StartDate = arrData(2, 1) + arrData(2, 2)
    Dim EndDate As Date
    EndDate = StartDate + arrData(2, 3) / 1440 + arrData(2, 4) / 1440

    Dim iRow As Long
    For iRow = 3 To UBound(arrData, 1) 'loop from data row 2 (= row 3) we used data row 1 in initialization already
        'determine start date of current row
        StartDate = arrData(iRow, 1) + arrData(iRow, 2)

        If arrData(iRow, 1) = arrData(iRow - 1, 1) And StartDate < EndDate Then 'check same cinician and overlapping
            'copy column 1 … 26 to error sheet
            wsErrors.Cells(LastErrorRow, 1).Resize(ColumnSize:=26).Value = wsData.Cells(iRow, 1).Resize(ColumnSize:=26).Value

            LastErrorRow = LastErrorRow + 1
        End If

        'remember end date of current row (for comparison with next row)
        EndDate = StartDate + arrData(iRow, 3) / 1440 + arrData(iRow, 4) / 1440
    Next iRow
End Sub