Nested For Loop работает мучительно медленно и не работает должным образом

Question

Код, который я сканирую на совпадения и выполняет несколько действий:

1. Во-первых, он проверяет, чтобы даты назначений были на или после даты запроса на тестирование.
2. Затем убедитесь, что ячейка для запроса не пуста, убедившись, что там указан точный код запроса (есть 6 столбцов для проверки кодов).
3. Затем он удостоверяется, что номер счета запроса и назначения совпадают.

Ниже приведены несколько условий:

• Если в запрошенную дату или после указанной даты назначена встреча с запрошенной службой, она ничего не должна делать и переходит к следующей строке.

• Если отсутствуют пропущенные встречи для запрашиваемых услуг, следует выделить ячейки желтым цветом.

• Если ячейка запроса на листе C пуста, код ничего не должен делать.

• Если слот запроса заполнен, но есть встреча в или после даты запроса, для той же учетной записи #, и тип запроса / тип встречи совпадают, код ничего не должен делать.

• Если нет, строка запроса должна быть выделена желтым цветом.

Задача

Помимо выделения их красным цветом, с которым я могу справиться, кажется, что код выделяет ВСЕ строки, вместо того, чтобы выделять только те, у которых запрошены услуги, но пропущены встречи.

Лист запросов - C, а лист ВСЕХ запланированных встреч - B. Приятно было бы ограничить циклы For только строками, содержащими данные, чтобы ускорить завершение процесса (возможно, добавить индикатор выполнения. ? Окно Excel и VBA отображают, что они не отвечают, но вентиляторы машин работают быстрее, поэтому я знаю, что он определенно что-то делает).

Данные

Чтобы сделать вещи немного проще:

• На листе C (лист запроса):

  Account # = Column A
  
  Request Date = Column G
  
  Request Type = Columns H-M
  

• На листе B (основной лист назначения):

  Account # = Column A (Must match Sheet C Column A)
  
  Appointment Date = Column L (Must be >= (Greater or equal) to Sheet C Column G
  
  Appointment Type = Column P (Must match Sheet C Column H-M)
  

Код

Sub check_for_copies()

Dim i As Long
Dim j As Long

For j = 2 To 1000

For i = 2 To 10000

    If Sheets("C").Cells(j, 7).Value <= Sheets("B").Cells(i, 12).Value And Sheets("C").Cells(j, 1).Value = Sheets("B").Cells(i, 1).Value And Sheets("C").Cells(j, 8).Value = "CR15" And Sheets("C").Cells(j, 8).Value = Sheets("B").Cells(i, 16).Value Then
        'do nothing
    ElseIf Sheets("C").Cells(j, 8).Value = "" Then
        'do nothing
    Else
        Sheets("C").Rows(j).Interior.ColorIndex = 3
    End If


    If Sheets("C").Cells(j, 7).Value <= Sheets("B").Cells(i, 12).Value And Sheets("C").Cells(j, 1).Value = Sheets("B").Cells(i, 1).Value And Sheets("C").Cells(j, 9).Value = "TR15" And Sheets("C").Cells(j, 9).Value = Sheets("B").Cells(i, 16).Value Then
        'do nothing
    ElseIf Sheets("C").Cells(j, 9).Value = "" Then
        'do nothing
    Else
        Sheets("C").Rows(j).Interior.ColorIndex = 3
    End If

    If Sheets("C").Cells(j, 7).Value <= Sheets("B").Cells(i, 12).Value And Sheets("C").Cells(j, 1).Value = Sheets("B").Cells(i, 1).Value And Sheets("C").Cells(j, 10).Value = "EEG60" And Sheets("C").Cells(j, 10).Value = Sheets("B").Cells(i, 16).Value Then
        'do nothing
    ElseIf Sheets("C").Cells(j, 10).Value = "" Then
        'do nothing
    Else
        Sheets("C").Rows(j).Interior.ColorIndex = 3
    End If


    If Sheets("C").Cells(j, 7).Value <= Sheets("B").Cells(i, 12).Value And Sheets("C").Cells(j, 1).Value = Sheets("B").Cells(i, 1).Value And Sheets("C").Cells(j, 11).Value = "EMG15" And Sheets("C").Cells(j, 11).Value = Sheets("B").Cells(i, 16).Value Then
        'do nothing
    ElseIf Sheets("C").Cells(j, 11).Value = "" Then
        'do nothing
    Else
        Sheets("C").Rows(j).Interior.ColorIndex = 3
    End If


    If Sheets("C").Cells(j, 7).Value <= Sheets("B").Cells(i, 12).Value And Sheets("C").Cells(j, 1).Value = Sheets("B").Cells(i, 1).Value And Sheets("C").Cells(j, 12).Value = "NV30" And Sheets("C").Cells(j, 12).Value = Sheets("B").Cells(i, 16).Value Then
        'do nothing
    ElseIf Sheets("C").Cells(j, 12).Value = "" Then
        'do nothing
    Else
        Sheets("C").Rows(j).Interior.ColorIndex = 3
    End If


    If Sheets("C").Cells(j, 7).Value <= Sheets("B").Cells(i, 12).Value And Sheets("C").Cells(j, 1).Value = Sheets("B").Cells(i, 1).Value And Sheets("C").Cells(j, 13).Value = "NV45" And Sheets("C").Cells(j, 13).Value = Sheets("B").Cells(i, 16).Value Then
        'do nothing
    ElseIf Sheets("C").Cells(j, 13).Value = "" Then
        'do nothing
    Else
        Sheets("C").Rows(j).Interior.ColorIndex = 3
    End If

Next

Next

End Sub

Код мучительно медленный и выглядит так, как будто он выходит из строя. Я пытался добавить

Application.Calculation = false
Application.ScreenUpdating = false
Application.EnableEvents = false

но это, похоже, не помогает!

Answer 1

Не используйте вложенные циклы For и выполняйте операции на основе наборов, такие как таблицы в реляционной базе данных или наборы данных / фреймы данных в инструментах анализа, таких как SAS, SPSS, Stata, Python's Pandas, R, Julia и другие. Это позволяет вам объединять или объединять эти два набора данных с помощью номера счета и типа запроса и выполнять любую операцию векторизованного столбца, намного более эффективную, чем итеративный цикл. Однако вы можете запустить Excel INDEX...MATCH, но для сравнения условных дат и пропущенных значений требуются массивы или формула массива.

К счастью, если вы используете Excel для Windows, вы можете взаимодействовать с JET / ACE SQL Engine (файлы .dll), где вы можете объединить два листа рабочей книги и создать необходимый столбец в качестве индикатора для выделения. Примечание: поскольку Excel не является базой данных и, следовательно, не соответствует правилам целостности данных, обязательно отформатируйте каждый столбец в одном типе данных (без типов смешивания), особенно сделайте столбцы даты фактическими датами или оставьте пустыми, в противном случае логика ниже не будет Работа.

---

SQL (превращение If условий во вложенные IIF или CASE в других СУБД)

При необходимости измените фактические имена столбцов и листов.

SELECT c.*, b.*, 
       IIF((b.[Appointment Date] >= c.[Request Date]) OR (c.[Request Date] IS NULL), 0,
           IIF(b.[Appointment Date] IS NULL, 1,
               IIF((b.[Appointment Date] < c.[Request Date]), 1, 0)
               )
           ) AS [highlight]                      
FROM [SheetC$] c
INNER JOIN [SheetB$] b
   ON c.[Account #] = b.[Account #] AND c.[Request Type] = b.[Appointment Type]

В качестве альтернативы и в идеале импортируйте два листа в фактическую базу данных (или вышеупомянутый инструмент анализа), такой как брат и сестра Excel, MS Access, и выполните тот же SQL-запрос, и получайте результаты дампа Access обратно в Excel для выделения целей или сохраняйте в Access и выполняйте условное форматирование в форме или отчете!

---

VBA (выполняется над запросом и выводит вывод запроса в существующую пустую таблицу результатов)

Использовать вычисленную строку выделения (со значениями 0 или 1) в Результаты лист для выделения желтой строки.

Sub RunSQL()    
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' CONNECTION STRINGS (DRIVER VERSION COMMENTED OUT)
'    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
'                      & "DBQ=C:\Path\To\Workbook.xlsm;"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Path\To\Workbook.xlsm';" _
                       & "Extended Properties=""Excel 12.0;HDR=YES;"";"

    strSQL = "SELECT c.*, b.*, " _
           &  "     IIF((b.[Appointment Date] >= c.[Request Date]) OR (c.[Request Date] IS NULL), 0, " _
           &  "         IIF(b.[Appointment Date] IS NULL, 1, " _
           &  "             IIF((b.[Appointment Date] < c.[Request Date]), 1, 0) " _
           &  "             ) " _
           &  "        ) AS [highlight]  " _                     
           &  " FROM [SheetC$] c " _
           &  " INNER JOIN [SheetB$] b " _
           &  "    ON c.[Account #] = b.[Account #] AND c.[Request Type] = b.[Appointment Type]"  

    ' OPEN CONNECTION
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS
    With Worksheet("Results")
        For i = 1 To rst.Fields.Count - 1
           .Cells(1, i) = rst.Fields(i).Name
        Next i        
       ' DATA ROWS
       .Range("A2").CopyFromRecordset rst
    End With

    rst.Close: conn.Close    
    Set rst = Nothing: Set conn = Nothing
End Sub