Страницы: 1
RSS
Макросом проставить время с интервалом + 1 час
 
Всем привет!!!
У меня есть макрос который прописывает цифры по порядку от N-го, до N-го
Код
Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Long
        n = InputBox("С какого номера начать?")
Dim m As Long
        m = InputBox("Какое количество маршрутов нужно сформировать?")
       For n = n To m
        ActiveCell.FormulaR1C1 = n
        Selection.Offset(1, 0).Select
Next n
 Else
 End If

End Sub
Нужно его помочь поменять, а точнее перевести на время. (с разностью + 1 час, дата не нужна)
С какого времени начать. (допустим 12:00:00)
И далее кол-во маршрутов (допустим 10)
Если кто знает "макросы связанные со временем подскажите" Со временем я завис, уже мозги кипят.
Спасибо.
 
Код
Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Date, t As Date, m&, i&
        n = InputBox("Начальное время в формате ""ч:мм""")
        t = InputBox("Периодичность в формате ""ч:мм""", , "1:00")
        m = InputBox("Какое количество маршрутов нужно сформировать?")
       For i = 0 To m - 1
            With ActiveCell.Offset(i)
                .Value = n + i * t
                .NumberFormat = "hh:mm"
            End With
        Next
 Else
 End If 
End Sub
Изменено: Михаил С. - 20.03.2015 11:31:21
 
Все ок, СПАСИБО, только не прыгает по объедененым
Код
Selection.Offset(1, 0).Select
Эта строчка пропала.
 
...и откуда мне знать про извращения с объединенными ячейками? ...я не экстрасенс...

Код
Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Date, t As Date, m&, i&
        n = InputBox("Начальное время в формате ""ч:мм""")
        t = InputBox("Периодичностьв формате ""ч:мм""", , "1:00")
        m = InputBox("Какое количество маршрутов нужно сформировать?")
       For i = 0 To m - 1
            ActiveCell.Offset(i).Select
           With ActiveCell
                .Value = n + i * t
                .NumberFormat = "hh:mm"
            End With
        Next
 Else
 End If
End Sub
Изменено: Михаил С. - 20.03.2015 12:09:53
 
Что то не верно, Цикл прибавляет каждый раз по пустой ячейке, и в итоге: непонятно
 
да, чуть ошибся.
Код
Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Date, t As Date, m&, i&
        n = InputBox("Начальное время в формате ""ч:мм""")
        t = InputBox("Периодичностьв формате ""ч:мм""", , "1:00")
        m = InputBox("Какое количество маршрутов нужно сформировать?")
       For i = 0 To m - 1
           With ActiveCell
                .Value = n + i * t
                .NumberFormat = "hh:mm"
            End With
            ActiveCell.Offset(1).Select
        Next
 Else
 End If
End Sub
 
Спасибо большее, все работает!!!!
Можно еще Вас потревожить???
Изменено: Vasyok - 20.03.2015 12:50:18
 
После 0:00, начинает проставлять дату 01.01.1900  1:00:00, есть какой вариант от даты избавиться.
 
замените строчку
Код
.Value = n + i * t
на
.Value = n + i * t - Int(n + i * t)
 
Я попробовал добавить еще одну переменную:
Код
Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Date, t As Date, m&, i&
        n = InputBox("Начальное время в формате ""ч:мм""")
        t = InputBox("Периодичностьв формате ""ч:мм""", , "1:00")
        m = InputBox("Какое количество маршрутов нужно сформировать?")
        s = InputBox("Маршрутов в час")
       For i = 0 To m - 1
       
         
        For q = 0 To s - 2
           With ActiveCell
                .Value = n + i * t - Int(n + i * t)
                .NumberFormat = "hh:mm"
            End With
             ActiveCell.Offset(1).Select
        Next
           
           
      With ActiveCell
                .Value = n + i * t - Int(n + i * t)
                .NumberFormat = "hh:mm"
            End With
            ActiveCell.Offset(1).Select
        Next
 Else
 End If
End Sub


S , но. что то пошло не так:
n и t - все понятно.
m - 50 маршрутов (допустим)
s - 3 (это на сколько маршрутов он должен поставить одно и тоже время)
Почему то макрос прописывает 150 строчек (маршрутов)
Как от этого можно избавиться
А так прописывает хорошо (до 50, а дальше лишнее)
 
Так правильно? Вроде работает

Код
Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Date, t As Date, m&, i&
        n = InputBox("Начальное время в формате ""ч:мм""")
        t = InputBox("Периодичностьв формате ""ч:мм""", , "1:00")
        m = InputBox("Какое количество маршрутов нужно сформировать?")
        s = InputBox("Маршрутов в час")
        m = m / s  'Добавил
     For i = 0 To m - 1
       
         
        For q = 0 To s - 2
           With ActiveCell
                .Value = n + i * t - Int(n + i * t)
                .NumberFormat = "hh:mm"
            End With
             ActiveCell.Offset(1).Select
        Next
           
           
      With ActiveCell
                .Value = n + i * t - Int(n + i * t)
                .NumberFormat = "hh:mm"
            End With
            ActiveCell.Offset(1).Select
        Next
 Else
 End If
End Sub

 
Не, как то криво!!!!
 
Код
Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Date, t As Date, m&, i&
        n = InputBox("Начальное время в формате ""ч:мм""")
        t = InputBox("Периодичностьв формате ""ч:мм""", , "1:00")
        m = InputBox("Какое количество маршрутов нужно сформировать?")
        s = InputBox("Маршрутов в час", , "1")
       For i = 0 To m  Step s
            For q = i To i + s - 1
                If q = m Then Exit For
                With ActiveCell
                     .Value = n + i * t - Int(n + i * t)
                     .NumberFormat = "hh:mm"
                 End With
                 ActiveCell.Offset(1).Select
            Next
        Next
 End If
End Sub
Изменено: Михаил С. - 20.03.2015 14:31:11
 
ОН прибавляет ко времени + s, и получается не на 1 час разница
Если 3 маршрута в час, то должен прописать: 12:00 12:00 12:00, 13:00 13:00 13:00 итд, пока не придёт предел "m"
Изменено: Vasyok - 20.03.2015 14:45:19
 
Извени, что Тебя задёргал, но большее спасибо за помощь.
 
Строка
                   
Код
.Value = n + i * t / s - Int(n + i * t / s)
 
СУПЕР, СУПЕР. Прямо в 10-ку, Спасибо.
Страницы: 1
Наверх