查找所有最早的日期并在msg框中显示它们

时间:2018-05-10 13:53:11

标签: excel vba excel-vba

我有这个代码,可以在我的工作表中查找具有最早日期的学生,并显示有关该学生的一些信息。但问题是这个子只显示了其中一个学生。我有一个以上同一个最早的学生,我想在一个msg框中显示所有这些。任何人都可以帮我解决这个问题。提前致谢! :)

Sub FindMin()
Dim Mn As Long
Mn = Application.Match(Application.Min(Range("D1:D18289")), Range("D1:D18289"), 0)

MsgBox ("For the oldest students: " & Range("D" & Mn) & " the following applies: 
PROGRAM_TYPE_NAME: " & Range("k" & Mn) & ", STUDENT_ID: " & Range("L" & Mn) & " and Convertet ENROLL_PERIOD: " & Range("M" & Mn))

End Sub

2 个答案:

答案 0 :(得分:0)

您需要使用FIND()或循环:

Sub FindMin()
    Dim Mn As Long, oldest As Date, msg As String

    With Application.WorksheetFunction
        oldest = .Min(Range("D1:D18289"))
    End With

    msg = ""
    For Mn = 1 To 18289
        If Cells(Mn, "D").Value = oldest Then
            msg = msg & vbCrLf & "For the oldest students: " & Range("D" & Mn) & " the following applies: PROGRAM_TYPE_NAME: " & Range("k" & Mn) & ", STUDENT_ID: " & Range("L" & Mn) & " and Convertet ENROLL_PERIOD: " & Range("M" & Mn)
        End If
    Next Mn

    MsgBox msg
End Sub

这会为您提供一个包含所有结果的MsgBox()

答案 1 :(得分:0)

另一种使用AutoFilter的方法:

Sub tgr()

    Dim ws As Worksheet
    Dim rMinCell As Range
    Dim dMin As Double
    Dim sDate As String
    Dim sText As String

    Set ws = ActiveWorkbook.ActiveSheet
    dMin = WorksheetFunction.Min(ws.Columns("D"))
    sDate = Format(dMin, ws.Range("D2").NumberFormat)

    sText = "For the oldest students: " & sDate & " the following applies:" & Chr(10)

    With ws.Range("D1", ws.Cells(ws.Rows.Count, "D").End(xlUp))
        .AutoFilter 1, sDate
        For Each rMinCell In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Cells
            sText = sText & Chr(10) & "PROGRAM_TYPE_NAME: " & ws.Cells(rMinCell.Row, "K").Value & ", STUDENT_ID: " & ws.Cells(rMinCell.Row, "L").Value & " and Convertet ENROLL_PERIOD: " & ws.Cells(rMinCell.Row, "M").Value & Chr(10)
        Next rMinCell
        .AutoFilter
    End With

    MsgBox sText

End Sub