Сравните и получите наибольшую дату и связанные поля

Question

Я очень новичок в использовании VBA для Excel, и мне нужно разработать код, который будет извлекать самые лучшие даты экзамена и связанные с ним поля (Дата экзамена, Дата проверки экзамена, Задание экзамена) и выводиться на другую вкладку под названием EXAMCI.

Из-за проблем с целостностью данных в файле ввода даты в некоторых случаях Дата экзамена (столбец D) будет больше, чем дата второго экзамена (столбец H), и наоборот; в некоторых случаях дата 2-го экзамена (столбец H) больше даты первого экзамена (столбец D).

Вот некоторые примеры данных из файла (столбцы A - K, слева направо):

Userid  Employee Name   DOB             Exam Date       Exam Check Date Exam Induration Exam Negative   2nd Exam Date   2nd Exam Check Date 2nd Exam Induration 2nd Exam Negative
1234    John Smith      1/1/01          5/22/17         5/24/17         0               Yes             12/6/17         12/8/17             0                   Yes
6481    Jill Son        2/2/02          11/18/15        11/21/15        0               Yes             2/23/17         2/26/17             0                   Yes
3271    Cathy John      3/3/03          7/17/17         7/19/17         0               Yes             6/15/16         6/17/16             0                   Yes

В приведенных выше примерах данных вы можете видеть, что первая Дата экзамена больше, чем вторая Дата экзамена для Джона Смита и Кэти Джон, однако 2-я Дата экзамена больше, чем первая Дата экзамена для Джилл Сон.

Я хочу, чтобы программа проверяла каждую строку, чтобы узнать, является ли Дата экзамена или 2-я дата экзамена наибольшей (из двух), а затем выдает идентификатор пользователя, Имя сотрудника, DOB и либо (Дата экзамена, Дата проверки и «Экзаменация экзамена») или («Дата 2-го экзамена», «Дата проверки 2-го экзамена и индукция 2-го экзамена») - в зависимости от того, какая связанная дата была больше.

Таким образом, в примере с Джоном Смитом и Джилл Сон я хотел бы вывести на вкладку EXAMCI следующие данные (метки столбцов могут оставаться неизменными, например, нет необходимости различать дату экзамена и дату второго экзамена:)

Userid     Employee Name    DOB       Exam Date     Exam Check Date    Exam Induration
1234       John Smith       1/1/01    5/22/17       5/24/17            0
3271       Jill Son         3/3/03    2/23/17       2/26/17            0

Пожалуйста, дайте мне знать, если требование не ясно, спасибо за любой отзыв!

EDIT:

Вот код, который я пытаюсь добавить в эту уже существующую программу, функция называется Examdate :

Public lstrow As Long, strDate As Variant, stredate As Variant

Sub importbuild()

Application.ScreenUpdating = False

'Define last row of exported data
lstrow = Worksheets("Data").Range("G" & Rows.Count).End(xlUp).Row

Worksheets("Data").Cells.Replace what:="=", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

'Run function to build import file for Hepatitis Immunizations
Call HepLoad("O", "P", "HB1")
Call HepLoad("Q", "R", "HB2")
Call HepLoad("S", "T", "HB3")
Call HepLoad("U", "V", "HB1")
Call HepLoad("W", "X", "HB2")
Call HepLoad("Y", "NA", "HB3")
'Run function for Hepatitis Series Completed
Call HepSeries("Z", "AA")
'Run function for Titers
Call Titer("AB", "AC", "HT")
Call Titer("AD", "AE", "RT")
Call Titer("AF", "AG", "UT")
Call Titer("AH", "AI", "VT")
'Run functions for Varicella Immunizations
Call DateOnlyLoad("AJ", "AK", "VAR1")
Call DateOnlyLoad("AL", "NA", "VAR2")
'Run function for Tetanus Immunizations
Call TetanusLoad("AM", "AN")
'Run function for MMR Immunizations
Call DateOnlyLoad("AO", "AP", "MMR1")
Call DateOnlyLoad("AQ", "NA", "MMR2")
'Call BCGLoad("BA", "NA", "BCG")
Call Examdate

Application.ScreenUpdating = True

End Sub

(другие функции опущены)

Function Examdate()

Dim Exam_1_Date As Variant
Dim Exam_2_Date As Variant
Dim i As Long, j As Long

j = Worksheets("PPDCI").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow

Exam_1_Date = Worksheets("Data").Range("AW" & i)
Exam_2_Date = Worksheets("Data").Range("BA" & i)

If Exam_1_Date > Exam_2_Date Then
   Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = 
Worksheets("Data").Range("F" & i & ":H" & i).Value
   Worksheets("PPDCI").Range("F" & j).Value = Exam_1_Date
Else
    If Exam_1_Date < Exam_2_Date Then
    Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = 
Worksheets("Data").Range("F" & i & ":H" & i).Value
    Worksheets("PPDCI").Range("F" & j).Value = Exam_2_Date
    End If
Worksheets("PPDCI").Range("F" & j).Value = "CAN NOT DETERMINE"
End If

Next i

End Function

Когда я пытаюсь запустить макрос, я получаю ошибку «Требуется объект». Нужно ли указывать переменные там, где вызывается функция? Также логика кажется правильной?

Answer 1

используйте оператор If … ElseIf … Else … End If и увеличьте j.

For i = 2 To lstrow
    Exam_1_Date = Worksheets("Data").Range("AW" & i)
    Exam_2_Date = Worksheets("Data").Range("BA" & i)

    If Exam_1_Date > Exam_2_Date Then
        Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
        Worksheets("PPDCI").Range("F" & j).Value = Exam_1_Date
    ElseIf Exam_1_Date < Exam_2_Date Then
        Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
        Worksheets("PPDCI").Range("F" & j).Value = Exam_2_Date
    Else
        Worksheets("PPDCI").Range("F" & j).Value = "CAN NOT DETERMINE"
    End If
    j = j + 1
Next i