到特定Cell Excel VBA休假计划的数据

Question

I am making a leave planner using one form where user choose his name than start date and end date and apply using VBA i am storing that data to Worksheet Column AB and C

Dim irow As Long, _
wS As Worksheet, _
NextRow As Long, _
cF As Range
Set wS = Worksheets("Sheet1")
With wS
With .Range("A:A")

    Set cF = .Find(What:=Me.Combo.Value, _
                After:=.Cells(1, 1), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False, _
                SearchFormat:=False)
    End With      
    If Not cF Is Nothing Then
    If cF.Offset(0, 1) <> vbNullString Then
        Set cF = cF.End(xlToRight).Offset(0, 1)
        cF.Value = Me.startdate.Value
        cF.Offset(0, 1).Value = Me.enddate.Value
    Else
        .Cells(cF.Row, "B").Value = Me.startdate.Value
        .Cells(cF.Row, "C").Value = Me.enddate.Value
    End If
Else
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    .Cells(NextRow, "A").Value = Me.Combo.Value
    .Cells(NextRow, "B").Value = Me.startdate.Value
    .Cells(NextRow, "C").Value = Me.enddate.Value
End If
End With

After Storing data i am using a formula to show those names in calendar

=IFERROR(INDEX($A$20:$A$151,MATCH(1,IF(DATE($D$1,ROWS($A$3:$A3),B$2)>=$B$20:$B$151,IF(DATE($D$1,ROWS($A$3:$A3),B$2)<=$C$20:$C$151,1)),0)),"")

Is there some change possible in VBA(To avoid Formula) so it will store directly where it intend to show as per image MAX 3 people can go on leave same dates so max 3 initials in one cell as per date range eg

• ABC(1 Jan to 5 Jan) DEF(3 Jan to 6 Jan) and XYZ(2 Jan to 7 Jan)
• So In Cell for January 1 ABC
• In Cell for January 2 ABC/XYZ
• In Cell for January 3 ABC/DEF/XYZ up to jan 5
• In Cell for January 6 DEF/XYZ
• In Cell for January 7 XYZ

Column width and height doesn't matter (big or small auto adjust) only want that data to be displayed on the calendar on respective dates range

Answer 1

Here is a UDF which you would use as a formula on the sheet directly:

    Function vac(dt As Date, rngnme As Range, rngstrt As Range, rngend As Range) As String
    Application.Volatile
    Dim i&
    Dim temp As String
    temp = ""

    For i = 1 To rngnme.Rows.Count
        If rngnme.Cells(i, 1) <> "" Then
            If rngstrt.Cells(i, 1) <= dt And rngend.Cells(i, 1) >= dt Then
                temp = temp & rngnme.Cells(i, 1) & ","
            End If
        End If
    Next i

    If temp = "" Then
        vac = CVErr(xlErrNA)
    ElseIf Len(temp) - Len(Replace(temp, ",", "")) > 3 Then
        vac = "> 3"
    Else
        vac = Left(temp, Len(temp) - 1)
    End If

End Function

Post this in a module not sheet code or thisworkbook code. Then you would call it by placing the following formula in B3:

=IFERROR(vac(DATE($D$1,ROWS($A$3:$A3),B$2),$A$20:$A$30,$B$20:$B$30,$C$20:$C$30),"")

Then copy over and down.

It will return "" if there is nobody assigned that day, or it will return the name separated by a comma, or if there are more than three it will return "> 3".

You could then apply a conditional format rule" =B3="> 3" and make it red or some other color to make it more visible.