Есть файл, обновляющийся раз в полчаса. В ячейке B2 фиксируется время последнего обновления в формате "16:00:00", "16:30:00" и т.д. В ячейках B3:B100 каждые полчаса обновляются данные. Нужно, чтобы макрос проверял время указанное в B2, находил соответствующее значение в строке 2 и вставлял данные из B3:B100 в x3:x100, где x - столбец с аналогичным временем.
Заранее спасибо!
Добрый день!
Помогите, пожалуйста, в написании макроса.
Есть файл, обновляющийся раз в полчаса. В ячейке B2 фиксируется время последнего обновления в формате "16:00:00", "16:30:00" и т.д. В ячейках B3:B100 каждые полчаса обновляются данные. Нужно, чтобы макрос проверял время указанное в B2, находил соответствующее значение в строке 2 и вставлял данные из B3:B100 в x3:x100, где x - столбец с аналогичным временем.
Вопрос - что изменяется последним - B1 или данные в столбце? Ну а код (не сложный) должен срабатывать по изменению последней обновляющейся ячейки. [vba]
Код
Sub newtime() Dim r As Range Set r = Rows(2).Find([b1].Text, , xlValues, xlWhole) If Not r Is Nothing Then [b3:b7].Copy r.Offset(1) End Sub
[/vba]
Вопрос - что изменяется последним - B1 или данные в столбце? Ну а код (не сложный) должен срабатывать по изменению последней обновляющейся ячейки. [vba]
Код
Sub newtime() Dim r As Range Set r = Rows(2).Find([b1].Text, , xlValues, xlWhole) If Not r Is Nothing Then [b3:b7].Copy r.Offset(1) End Sub
Вижу, меня немного опередили, пока писал =) Моё решение чисто для сравнения как делают профи ( Hugo) и новички вроде меня =)
[vba]
Код
Sub Data_to_time()
Application.ScreenUpdating = False With ThisWorkbook.Worksheets("Data")
Dim LastRow As Long 'для определения высоты столбцов Dim LastRow2 As Long 'для определения высоты столбцов Dim Runner As Integer 'счётчик для поиска соответствия по времени Dim Test As Integer 'Чтобы Runner'у знать, когда остановиться Dim X As Long 'для переноса отдельных ячеек
Runner = 2 Test = 0
Do While .Cells(2, Runner + 1) <> 0 Runner = Runner + 1 If .Cells(2, Runner).Value = .Cells(1, 2).Value Then Test = 1 Exit Do End If Loop
If Test = 1 Then LastRow = .Cells(Rows.Count, 2).End(xlUp).Row LastRow2 = .Cells(Rows.Count, Runner).End(xlUp).Row For X = 3 To LastRow .Cells(LastRow2 + X - 2, Runner).Value = .Cells(X, 2).Value Next X Else MsgBox "Проверьте введённое время!", , "Ошибка!" End If
End With Application.ScreenUpdating = True
End Sub
[/vba]
При этом у Hugo макрос легко работает с временем, введённым вручную. Мой же работает только если скопировать время из названия столбца. Интересно, почему.
ArkaIIIa, здравствуйте.
Вижу, меня немного опередили, пока писал =) Моё решение чисто для сравнения как делают профи ( Hugo) и новички вроде меня =)
[vba]
Код
Sub Data_to_time()
Application.ScreenUpdating = False With ThisWorkbook.Worksheets("Data")
Dim LastRow As Long 'для определения высоты столбцов Dim LastRow2 As Long 'для определения высоты столбцов Dim Runner As Integer 'счётчик для поиска соответствия по времени Dim Test As Integer 'Чтобы Runner'у знать, когда остановиться Dim X As Long 'для переноса отдельных ячеек
Runner = 2 Test = 0
Do While .Cells(2, Runner + 1) <> 0 Runner = Runner + 1 If .Cells(2, Runner).Value = .Cells(1, 2).Value Then Test = 1 Exit Do End If Loop
If Test = 1 Then LastRow = .Cells(Rows.Count, 2).End(xlUp).Row LastRow2 = .Cells(Rows.Count, Runner).End(xlUp).Row For X = 3 To LastRow .Cells(LastRow2 + X - 2, Runner).Value = .Cells(X, 2).Value Next X Else MsgBox "Проверьте введённое время!", , "Ошибка!" End If
End With Application.ScreenUpdating = True
End Sub
[/vba]
При этом у Hugo макрос легко работает с временем, введённым вручную. Мой же работает только если скопировать время из названия столбца. Интересно, почему.Rioran
Hugo Массив данных выгружается при помощи связей. Обновление происходит при помощи макроса. В этом же макросе, следующей строкой, идет определение времени обновления файла-исходника - оттуда и тянется время. Столкнулся с проблемой. Если значения в столбце B (которые копируются) вбиты вручную - то всё ок, а если это ссылки - то переносятся нули.
Hugo Массив данных выгружается при помощи связей. Обновление происходит при помощи макроса. В этом же макросе, следующей строкой, идет определение времени обновления файла-исходника - оттуда и тянется время. Столкнулся с проблемой. Если значения в столбце B (которые копируются) вбиты вручную - то всё ок, а если это ссылки - то переносятся нули.ArkaIIIa
Rioran Ваш макрос почему-то чувствителен к выбору времени из списка, а у меня время подтягивается формулой. И в Вашем маркросе, если дважды его использовать не меняя времени, то он дважды вставит значения (одни под другими).
Rioran Ваш макрос почему-то чувствителен к выбору времени из списка, а у меня время подтягивается формулой. И в Вашем маркросе, если дважды его использовать не меняя времени, то он дважды вставит значения (одни под другими).ArkaIIIa
Ну я не стал заморачиваться с определением диапазона копирования - что копировать на практике скорее всего будет неизменным диапазоном (можно сразу забить в код), куда копировать - нужно знать одну ячейку. Если столбцов много - то перебирать все (ну в худшем случае, поздно вечером) намного дольше, чем найти одну ячейку. Но если как тут всего 48 значений - то и без разницы, можно и перебирать, тем более что поиск времени кодом дело привередливое... А чтоб сравнивать вручную - можно так: [vba]
Код
If CStr(.Cells(2, Runner).Value) = CStr(.Cells(1, 2).Value) Then
[/vba] Вообще это хитрый момент, можно попасться... И Вы попались! С виду значения всюду одинаковы - но не равны!
Ну я не стал заморачиваться с определением диапазона копирования - что копировать на практике скорее всего будет неизменным диапазоном (можно сразу забить в код), куда копировать - нужно знать одну ячейку. Если столбцов много - то перебирать все (ну в худшем случае, поздно вечером) намного дольше, чем найти одну ячейку. Но если как тут всего 48 значений - то и без разницы, можно и перебирать, тем более что поиск времени кодом дело привередливое... А чтоб сравнивать вручную - можно так: [vba]
Код
If CStr(.Cells(2, Runner).Value) = CStr(.Cells(1, 2).Value) Then
[/vba] Вообще это хитрый момент, можно попасться... И Вы попались! С виду значения всюду одинаковы - но не равны!Hugo
Hugo К сожалению, я мало что понял из вышенаписанного...))) Немного изменил условия (пример во вложении). Вцелом предыдущий Ваш макрос - работает отлично. Но как сделать чтобы он подставлял значения, который отображаются в ячейках с формулами? (в примере это столбец С). Т.е. условия все те же, но теперь он должен подтягивать инфу из ячеек столбца С.
Hugo К сожалению, я мало что понял из вышенаписанного...))) Немного изменил условия (пример во вложении). Вцелом предыдущий Ваш макрос - работает отлично. Но как сделать чтобы он подставлял значения, который отображаются в ячейках с формулами? (в примере это столбец С). Т.е. условия все те же, но теперь он должен подтягивать инфу из ячеек столбца С.ArkaIIIa
Вообще было бы любопытно увидеть как Вы код прикрутили, ну да ладно... Вот спецвставка: [vba]
Код
Sub newtime() Dim r As Range Set r = Rows(2).Find([C1].Text, , xlValues, xlWhole) If Not r Is Nothing Then [C3:C7].Copy r.Offset(1).PasteSpecial Paste:=xlPasteValues End If End Sub
[/vba]
Вообще было бы любопытно увидеть как Вы код прикрутили, ну да ладно... Вот спецвставка: [vba]
Код
Sub newtime() Dim r As Range Set r = Rows(2).Find([C1].Text, , xlValues, xlWhole) If Not r Is Nothing Then [C3:C7].Copy r.Offset(1).PasteSpecial Paste:=xlPasteValues End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
С виду значения всюду одинаковы - но не равны!
