Excel VBA перевод даты в другой формат

Question

Действительно новый для Excel VBA.Работал над одной задачей и пытался объединить все различные элементы в один рабочий макрос.

Вот моя цель

. Как вы можете видеть на картинке, есть список идентификаторов и имен, которыесообщил о своем отпуске в течение месяца.

Я хотел бы перевести в нижеуказанный формат дату начала / дату окончания / количество занятых часов

1 Попробовал код для захвата даты начала, но не смог возобновить циклчтобы зафиксировать конечную дату.

Sub FindMatchingValue()
    Dim i As Integer, intValueToFind As Integer
    intValueToFind = 8
    For i = 1 To 500    ' Revise the 500 to include all of your values
        If Cells(2, i).Value = intValueToFind Then
            MsgBox ("Found value on row " & i)
            Cells(2, 35).Value = Cells(1, i) 'copy the start date to same row column 35
            Exit Sub
        End If
    Next i

    ' This MsgBox will only show if the loop completes with no success
    MsgBox ("Value not found in the range!")
End Sub

2 Конечной датой будет последний день для сотрудника, ушедшего в отпуск в последовательные дни.

Действительно благодарен за помощь нашего сообщества.

Answer 1

Следующий код вернет вам первый набор последовательных отпусков для первого идентификатора (строка 2) с датой начала, датой окончания и часами:

Sub FindMatchingValue()
    Dim i As Integer, intValueToFind As Integer, Found As Boolean, HoursTaken As Single
    intValueToFind = 8
    For i = 1 To 34    'Considering 34 is the max date column
        If Found Then
            If Cells(2, i).Value = "" Then
                MsgBox ("Last consecutive column " & i - 1)
                Cells(2, 36).Value = Cells(1, i - 1) 'copy the end date to same row column 36
                Cells(2, 37).Value = HoursTaken 'Hours taken to same row column 37
                Found = False
                Exit Sub 'Skip after first set of leave
            Else
                HoursTaken = HoursTaken + Cells(2, i)
            End If
        ElseIf Cells(2, i).Value = intValueToFind Then
            MsgBox ("Found value on column " & i)
            Cells(2, 35).Value = Cells(1, i) 'copy the start date to same row column 35
            Found = True
            HoursTaken = Cells(2, i)
        End If
    Next i

    'This MsgBox will only show if the loop completes with no success
    MsgBox ("Value not found in the range!")
End Sub

Вам нужно больше думать о том, как вы будете сниматьследующие наборы оставляют для одного и того же человека и запускают его для всего набора строк данных.Надеюсь, это поможет решить вашу проблему.