Результаты поиска и вычисления expiratrion

Question

У меня есть два отчета о данных, в которых я сортирую данные в отчете данных 1 и перемещаю его на лист под названием «Список». Чтобы завершить отчет, я затем,

1. Получить дату из отчета о данных по две для каждой строки, которая у меня есть, в отсортированном списке. Для этого я попытался взять название действия в столбце «G» в листе «Список», а затем я ищу его в листе «Data2» в столбце «C», затем возвращаю номер строки и хочу сохранить число в столбце «G». Это число - это дни до крайнего срока и может быть либо положительным, либо отрицательным числом.
2. Возьмите сегодняшнюю дату +/- номер и поместите измененную дату и лист «Списки» в столбце «N», чтобы иметь возможность видеть, когда у каждой задачи установлен крайний срок.

Я не могу получить другие данные в отчетах, поэтому я должен решить это с помощью некоторых VBA. Код, который я пробовал, это.

Sub InsertDate() 

    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Dim i As Integer 
    Dim RowNr As Long 
    Dim ActionTitle As String 
    Dim DaysToExp As Long 
    Dim ExpDate As Date 
    Dim Found As Range 
    Dim FoundRow As Long 
    Dim Sign As String 
    Dim Days As String 
    Dim RowNr2 As Long 

    ScreenUpdate = False 

    RowNr = ThisWorkbook.Worksheets("List").Range("A" & Rows.count).End(xlUp).row 
    RowNr2 = ThisWorkbook.Worksheets("Data2").Range("A" & Rows.count).End(xlUp).row 
    Set ws1 = ThisWorkbook.Worksheets("List") 
    Set ws2 = ThisWorkbook.Worksheets("Data2") 

    ws1.Range("N1").Value = "Expected start date" 

    For i = 2 To RowNr 
     ActionTitle = ws1.Range("G" & i).Value 

     Set Found = ws2.Range("C1:C" & RowNr2).Find(What:=ActionTitle, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Activate 

     FoundRow = ActiveCell.row 

     Days = ws2.Range("G" & FoundRow).Value 

     If Days = "" Then 
      DaysToExp = DaysToExp + 0 
     ElseIf Left(Days, 1) = "-" Then 
      Sign = "-" 
      DaysToExp = Replace(Days, "-", "") 
     Else 
      Sign = "+" 
      DaysToExp = DaysToExp + Days 
     End If 

     ExpDate = "=TODAY() & Sign & DaysToExp" 

     ThisWorkbook.Worksheets("List").Range("N" & i).Value = ExpDate 
    Next i 

    ScreenUpdate = True 

End Sub 

Answer 1

Я ужесточил ваш код немного и удалил .Find вместо функции рабочего листа .Match. Вам не нужно разбирать знаки Days, так как вы можете добавить отрицательное количество ко времени.

Sub InsertDate() 

    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim i As Long 
    Dim RowNr As Long, DaysToExp As Long, FoundRow As Long, RowNr2 As Long 
    Dim ActionTitle As String, Sign As String, Days As String 
    Dim ExpDate As Date 
    Dim Found As Range 

    Application.ScreenUpdating = False 

    Set ws1 = ThisWorkbook.Worksheets("List") 
    Set ws2 = ThisWorkbook.Worksheets("Data2") 

    RowNr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row 

    With ws1 
     RowNr = .Range("A" & Rows.Count).End(xlUp).Row 
     .Range("N1").Value = "Expected start date" 

     For i = 2 To RowNr 
      ActionTitle = ws1.Range("G" & i).Value 

      If CBool(Application.CountIf(ws2.Range("C1:C" & RowNr2), ActionTitle)) Then 
       FoundRow = Application.Match(ActionTitle, ws2.Range("C1:C" & RowNr2), 0) 
       Days = ws2.Range("G" & FoundRow).Value 
       ExpDate = Date + Days 
       .Range("N" & i).Value = ExpDate 
      Else 
       Debug.Print "missing " & ActionTitle 
      End If 
     Next i 
    End With 

    Application.ScreenUpdating = True 

End Sub 

Я бросил Debug.Print в том, что сообщит в открывшееся окно в VBE, если ActionTitle не может быть найден.