Как изменить дату при копировании с помощью макроса?

Question

Я пишу макрос в VBA.У меня есть цикл, который просматривает список дат, и каждая запись, где минута 00,15.30.45, копирует дату и время в новый столбец.Это только часть кода, над которым я работаю, поэтому сейчас он кажется бессмысленным.Моя проблема в том, что мне нужно изменить время, которое копируется в новый столбец.Мне нужно, чтобы дата оставалась неизменной, но время должно быть изменено так:

hh:00 becomes   hh-1:45
hh:15 becomes   hh  :00
hh:30 becomes   hh  :15
hh:45 becomes   hh  :30

У меня ниже текущего кода, который у меня есть, и все работает, за исключением, очевидно, что оно не изменяет время, потому что я только что сделалчтобы понять, что я хочу сделать.Какой код мне нужно изменить час и минуту?Спасибо!

Dim X As Integer

Range("A2").Select
NumRows = Range(Selection, Selection.End(xlDown)).Rows.Count
Range("A2").Select

For X = 2 To NumRows
    If (Minute(ActiveCell.Value) = 0) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH-1:45"
    ElseIf (Minute(ActiveCell.Value) = 15) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH:00"        
    ElseIf (Minute(ActiveCell.Value) = 30) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH:15" 
    ElseIf (Minute(ActiveCell.Value) = 45) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH:30"
    End If

    Selection.Offset(1, 0).Select
Next X

Answer 1

Я нахожусь в bar-b-que ( Счастливого 4-го июля каждого ), и это кажется намного более интересным, чем гости, которые здесь.

Таким образом, чтобы добавить время, как вы знаете, inutes, вам, вероятно, следует использовать TimeSerial Function . Я пытался изменить ваш код, чтобы сделать то, что вы сказали, но, честно говоря, это сложно во время бар-б-Q.

Пара предложений.

1. Не использовать select
2. Не использовать целое число
3. Чтобы добавить 4 часа 3 минуты и 8 секунд к дате .... TimeSerial(4, 3, 8)

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

Sub Running_From_That_Water_Like_My_Name_Was_TedKennedy()

Dim X As Long, WSheet As Worksheet, increaseAMOUNT As Double


Set WSheet = ActiveSheet '<---- make sure this is correct

With WSheet


Dim aCell As Range: Set aCell = .Range("A2")
Dim increaseAMOUNT As Double: increaseAMOUNT = TimeSerial(0, 15, 0) 'this adds `15 minutes



For X = 2 To Range(Range("A2"), Range("A2").End(xlDown)).Rows.Count


    If (Minute(ActiveCell.Value) = 0) Then

    Range("D2").Value = aCell.Value + increaseAMOUNT '<----you can modify the amount to increase consistently or include your own TimeSerial
    Range("D2").NumberFormat = "YYYY-MM-DD HH-1:45"


    ElseIf (Minute(aCell.Value) = 15) Then
    Range("D2").Value = aCell.Value + increaseAMOUNT
    Range("D2").NumberFormat = "YYYY-MM-DD HH:00"

    ElseIf (Minute(aCell.Value) = 30) Then
   Range("D2").Value = aCell.Value + increaseAMOUNT
    Range("D2").NumberFormat = "YYYY-MM-DD HH:15"

    ElseIf (Minute(aCell.Value) = 45) Then
    Range("D2").Value = aCell.Value + increaseAMOUNT
    Range("D2").NumberFormat = "YYYY-MM-DD HH:30"


    End If



    Set aCell = aCell.Offset(1, 0)

    Next X
End With


End Sub
'People-I-know.Girls.Count = 0