想通过考勤表里的请假得到请假的时间段

任鹏2022

Function YLeaveVBA_Fixed(dat As Variant, rng As Variant, str As String) As String
    Dim a() As Variant
    Dim b() As Variant
    Dim s As String
    Dim j As Integer
    Dim ds As Variant
    Dim de As Variant
    Dim i As Integer
    Dim wsFunc As WorksheetFunction
    Set wsFunc = Application.WorksheetFunction

    a = WorksheetFunction.Transpose(dat.Value2)
    b = WorksheetFunction.Transpose(rng.Value2)

    '估字符串长度
    Dim estimatedLength As Long
    estimatedLength = 1000  '据实际情况预估一个合理的初始长度
    s = String(estimatedLength, " ")

    j = 0
    ds = ""
    de = ""

    For i = 1 To UBound(b)
        If InStr(1, b(i, 1), str) > 0 Then
            j = j + 1
            If j = 1 Then
                ds = a(i, 1)
            End If
            de = a(i, 1) ' 每次遇到符合条件的都更新截止日期
        Else
            If de <> "" Then
                Dim formattedStart As String
                Dim formattedEnd As String
                formattedStart = wsFunc.Text(ds, "yyyy/m/d-")
                formattedEnd = wsFunc.Text(de, "yyyy/m/d")
                s = s & formattedStart & formattedEnd & vbNewLine
            End If
            j = 0
            ds = ""
            de = ""
        End If
    Next i

    YLeaveVBA_Fixed = Left(s, Len(s) - 2)
End Function