Vba 比较并获取最大日期和相关字段

Vba 比较并获取最大日期和相关字段,vba,excel,Vba,Excel,我对使用VBA for Excel非常陌生,需要开发一些代码来检索一个人最重要的考试日期和相关字段“考试日期”、“考试检查日期”、“考试硬度”,并输出到另一个名为EXAMCI的选项卡 由于日期输入文件存在数据完整性问题,在某些情况下,检查日期D列将大于第二次检查日期H列,反之亦然;在某些情况下,第二次检查日期列H大于第一次检查日期列D 以下是文件中的一些示例数据,列为A-K,从左到右: Userid Employee Name DOB Exam Date

我对使用VBA for Excel非常陌生,需要开发一些代码来检索一个人最重要的考试日期和相关字段“考试日期”、“考试检查日期”、“考试硬度”,并输出到另一个名为EXAMCI的选项卡

由于日期输入文件存在数据完整性问题,在某些情况下,检查日期D列将大于第二次检查日期H列,反之亦然;在某些情况下,第二次检查日期列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
在上面的示例数据中,您可以看到John Smith和Cathy John的第一次考试日期大于第二次考试日期,而Jill Son的第二次考试日期大于第一次考试日期

我想让程序做的是检查每一行,看看考试日期或第二次考试日期是否是两者中最大的,然后输出用户名、员工姓名、DOB,以及考试日期、考试日期和考试硬结或第二次考试日期、第二次考试检查日期和第二次考试硬结-取决于哪个关联日期更大

因此,在示例John Smith和Jill Son中,我希望在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
请让我知道,如果要求不明确,感谢任何反馈

编辑:

下面是我试图添加到这个已经存在的程序中的代码,函数名为Examdate:

公共lstrow为长,strDate为变体,stredate为变体

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
省略了其他功能

当我试图运行宏时,我得到一个对象必需的错误。我需要在调用函数的地方指定变量吗?逻辑是否正确?

使用If…ElseIf…Else…End If语句并增加j


您可以使用带有简单公式的helper列来确定第一个或第二个日期是grater=IFD:D>H:H,1,2,因此如果第一个大于1,则输出1,如果第二个大于2,则输出2。然后使用文件管理器在此帮助器列中筛选1或2。当然,您可以轻松地将过滤后的数据复制到另一张表中。•因为这不是免费的代码编写服务,所以请自己开始编写代码,然后带着代码回来,并告诉您在哪里遇到了卡滞或错误。@Pᴇʜ我编辑了帖子以包含我的代码。从设置考试日期中删除设置。变量的类型为date,它只是一个值而不是一个对象。仅对象需要设置。还要确保使用OptionExplicit并正确定义所有变量。我想我能坚持多久。而且k和j似乎没有定义,所以它们是0,这使得Range F&k失败,因为没有第0行。@PᴇʜI进行了更改,并从变量中删除了Set。它会运行,但不会返回预期的数据。它只返回2行上重复的1条记录。我希望返回更多的数据…因为您没有增加j。每次添加数据时,您都需要一个j=j+1,否则它将始终覆盖到同一行。@谢谢,我现在得到的数据返回了日期,但是我注意到我的记录有多个重复的行。例如,一个人有4行,其中3行有无法确定的内容,第4行包含ExamDate。知道为什么会发生这种情况吗?@nick不知道,因为我不知道你的数据是什么样子。我建议用F8一步一步地检查代码,并调试发生了什么,检查变量值,以及每一步检查哪一行。@Peh谢谢,只是不确定是否需要将if语句中的任何内容更改为类似Exam_1_Date.Value>Exam_2_Date.Value,而不是Exam_1_Date>Exam_2_Date。@Nick只是另一个想法:用cannot determinate移除最后一个Else块,并在第一个if和ElseIf中移动j=j+1,看看这是否修复了您的错误问题。@Peh再次感谢,问题是我已经运行了几次宏,每次它都在同一工作表上复制,并创建了重复项。现在一切看起来都很好!这对我来说是一个很好的练习,可以体验VBA!再次感谢你的帮助!
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
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