Обновите строку, если столбец отображается устаревшим

Question

У меня есть кусок кода, который работал для части, но потребовалось много времени (около 1700 строк). Когда я обновил его для выполнения всей функции, он теперь ничего не делает - не уверен, где я ошибся, и есть ли версия кода, которая была бы быстрее? Я все еще очень новичок, поэтому делайте мой код, ища то, что я хочу сделать, затем сгибая его под себя.

Я хотел бы проверить в столбце I все даты, которые меньше даты в ячейке Z1. Если в какой-либо ячейке в соответствующем ряду указано «Выдано», я бы хотел изменить его на «Просрочено».

Sub updateoverdue()
  Application.ScreenUpdating = True

  Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long
  Dim sh_1, sh_3 As Worksheet

  Set sh_1 = Sheet6
  Set sh_3 = Sheet6

  lastRow1 = sh_1.UsedRange.Rows.Count

  For j = 2 To lastRow1
  Sheet6.Range("z1") = sh_1.Cells(j, 9).Value

  lastRow2 = sh_3.UsedRange.Rows.Count

  For i = 2 To lastRow2
      If sh_3.Cells(i, 9).Value < Sheet6.Range("z1") And sh_3.Cells(i, 10).Value = "Issued" Then
          sh_3.Cells(i, 10).Value = "Overdue"
      End If

      Next i

    Next j

  Application.ScreenUpdating = True
  End Sub

Я заставил его работать только над столбцом J, но потом он не сработал, когда я добавил в выпущенную часть. Кроме того, я не могу изменить более одного столбца (от J до W).

Answer 1

Что-то вроде этого может работать для вас:

Sub tgr()

    Dim ws As Worksheet
    Set ws = Sheet6

    Dim TargetDate As Date
    TargetDate = ws.Range("Z1").Value2

    Dim DateList As Range
    Set DateList = ws.Range("I2", ws.Cells(ws.Rows.Count, "I").End(xlUp))
    If DateList.Row < 2 Then Exit Sub   'No dates

    Dim DateCell As Range
    For Each DateCell In DateList.Cells
        If DateCell.Value2 > TargetDate And LCase(Trim(DateCell.Offset(, 1).Value)) = "issued" Then
            DateCell.Offset(, 1).Value = "Overdue"
        End If
    Next DateCell

End Sub

Answer 2

Я проверил это, и оно работало нормально:

Sub try()

Dim ws As Worksheet, lastrow As Long
Set ws = Sheet6
lastrow = ws.Cells(Rows.Count, 9).End(xlUp).Row

Application.ScreenUpdating = False

For i = 1 To lastrow
    If ws.Cells(i, 9).Value < ws.Cells(1, 26).Value Then
        ws.Cells(i, 10).Value = "Overdue"
    ElseIf ws.Cells(i, 9).Value > ws.Cells(1, 26).Value Then
        ws.Cells(i, 10).Value = "Issued"
    Else
        ws.Cells(i, 10).Value = "Due Today"
    End If
Next i

Application.ScreenUpdating = True

End Sub

Или вы можете просто использовать формулу Excel и поместить ее вниз на весь столбец:

=IF(I1<$Z$1, "Issued","Overdue")