Еще раз обращаюсь к уважаемому собранию за помощью. Понял, что без макросов мне не обойтись, а самостоятельно их писать не умею. :(
Суть проблемы: чтобы не качать регулярно из БД десятки мегабайт, хочу получаемые данные ограничить по условию статус=архив И срок от даты до сегодня < 2мес. Чтобы архивные данные в Экселе не потеряли значения, планирую регулярно переводить их в текст/число (скопировать и вклеить как значения). Условия для Экселя такие же как и для базы но временной интервал вдвое короче. Регулярность - примерно раз в неделю Помогите, если это реально. Файл примера в аттаче.
Еще раз обращаюсь к уважаемому собранию за помощью. Понял, что без макросов мне не обойтись, а самостоятельно их писать не умею. :(
Суть проблемы: чтобы не качать регулярно из БД десятки мегабайт, хочу получаемые данные ограничить по условию статус=архив И срок от даты до сегодня < 2мес. Чтобы архивные данные в Экселе не потеряли значения, планирую регулярно переводить их в текст/число (скопировать и вклеить как значения). Условия для Экселя такие же как и для базы но временной интервал вдвое короче. Регулярность - примерно раз в неделю Помогите, если это реально. Файл примера в аттаче.Кравченко
Public Sub test() Dim rng1 As Range, rng2 As Range Dim i As Long, j& Const deltDay As Byte = 7 'дельта в днях Const strUslov As String = "архив"
j = Cells(Rows.Count, "D").End(xlUp).Row For Each rng1 In Range(Cells(9, "D"), Cells(9, "D")) If IsNumeric(rng1.Value2) Then i = rng1.Row If (DateDiff("d", rng1.Value, Now) >= deltDay) And (UCase(Cells(i, "F").Text) = UCase(strUslov)) Then i = rng1.Row For Each rng2 In Range(Cells(i, "A"), Cells(i, "K")) Cells(rng2.Row, rng2.Column).Value = rng2.Value2 Next End If End If Next End Sub
[/vba] упс, забыл про условия, сейчас подправлю
подправил
запускать по мере надобности
Этот код в лист [vba]
Код
Public Sub test() Dim rng1 As Range, rng2 As Range Dim i As Long, j& Const deltDay As Byte = 7 'дельта в днях Const strUslov As String = "архив"
j = Cells(Rows.Count, "D").End(xlUp).Row For Each rng1 In Range(Cells(9, "D"), Cells(9, "D")) If IsNumeric(rng1.Value2) Then i = rng1.Row If (DateDiff("d", rng1.Value, Now) >= deltDay) And (UCase(Cells(i, "F").Text) = UCase(strUslov)) Then i = rng1.Row For Each rng2 In Range(Cells(i, "A"), Cells(i, "K")) Cells(rng2.Row, rng2.Column).Value = rng2.Value2 Next End If End If Next End Sub
Udik, честно говоря, даже не обратил внимания. Увы, отсутствие опыта на этом форуме дает знать. Модераторы, админы исправьте пожалуйста мою ошибку. [moder]Месяц без 2-х дней - это отсутствие опыта? Правила форума хоть раз прочитали? Тему перенес, но ...
Udik, честно говоря, даже не обратил внимания. Увы, отсутствие опыта на этом форуме дает знать. Модераторы, админы исправьте пожалуйста мою ошибку. [moder]Месяц без 2-х дней - это отсутствие опыта? Правила форума хоть раз прочитали? Тему перенес, но ...Кравченко
Сообщение отредактировал _Boroda_ - Четверг, 25.02.2016, 16:49
Udik, спасибо за оперативность. После изменения (Cells(9, "D"), Cells(9, "D")) на (Cells(2, "D"), Cells(20, "D")) заработало во всем диапазоне. И сработало хорошо.
Есть одно "но". Можно ли указать динамический диапазон строк, например на высоту таблицы или ограничиться снизу пустой строкой? Дело в том, что таблица будет расти, а под ней планируются статистические данные. И в этом варианте макроса мне придется хотя бы раз в пол года на 3-4 машинах править макрос.
И вопросы. Как же без них. 1. Какие два столбца пришлось форматировать? 2. Хотел спросит про переменную j. Что она определяет?
По поводу "...Перевод по циклу значений в текст..." - это я (типа в слух) перечислял команды первого варианта макроса. Вы всё правильно поняли.
Udik, спасибо за оперативность. После изменения (Cells(9, "D"), Cells(9, "D")) на (Cells(2, "D"), Cells(20, "D")) заработало во всем диапазоне. И сработало хорошо.
Есть одно "но". Можно ли указать динамический диапазон строк, например на высоту таблицы или ограничиться снизу пустой строкой? Дело в том, что таблица будет расти, а под ней планируются статистические данные. И в этом варианте макроса мне придется хотя бы раз в пол года на 3-4 машинах править макрос.
И вопросы. Как же без них. 1. Какие два столбца пришлось форматировать? 2. Хотел спросит про переменную j. Что она определяет?
По поводу "...Перевод по циклу значений в текст..." - это я (типа в слух) перечислял команды первого варианта макроса. Вы всё правильно поняли.Кравченко
хы, это я на время отладки указал одну строку, а потом включить весь диапазон забыл .
два столбца: D, Q поставил краткий формат даты (может и без этого будет прекрасно работать) j переименовал и коммент поставил.
[vba]
Код
Public Sub test() Dim rng1 As Range, rng2 As Range Dim i As Long, rowLast& Const deltDay As Byte = 7 'дельта в днях Const strUslov As String = "архив" Const rowStart As Byte = 2 'первая строка с данными
rowLast = Cells(Rows.Count, "D").End(xlUp).Row 'последняя заполненная ячейка в столбце For Each rng1 In Range(Cells(rowStart, "D"), Cells(rowLast, "D")) If IsNumeric(rng1.Value2) Then i = rng1.Row If (DateDiff("d", rng1.Value, Now) >= deltDay) And (UCase(Cells(i, "F").Text) = UCase(strUslov)) Then For Each rng2 In Range(Cells(i, "A"), Cells(i, "K")) Cells(rng2.Row, rng2.Column).Value = rng2.Value2 Next End If End If Next End Sub
хы, это я на время отладки указал одну строку, а потом включить весь диапазон забыл .
два столбца: D, Q поставил краткий формат даты (может и без этого будет прекрасно работать) j переименовал и коммент поставил.
[vba]
Код
Public Sub test() Dim rng1 As Range, rng2 As Range Dim i As Long, rowLast& Const deltDay As Byte = 7 'дельта в днях Const strUslov As String = "архив" Const rowStart As Byte = 2 'первая строка с данными
rowLast = Cells(Rows.Count, "D").End(xlUp).Row 'последняя заполненная ячейка в столбце For Each rng1 In Range(Cells(rowStart, "D"), Cells(rowLast, "D")) If IsNumeric(rng1.Value2) Then i = rng1.Row If (DateDiff("d", rng1.Value, Now) >= deltDay) And (UCase(Cells(i, "F").Text) = UCase(strUslov)) Then For Each rng2 In Range(Cells(i, "A"), Cells(i, "K")) Cells(rng2.Row, rng2.Column).Value = rng2.Value2 Next End If End If Next End Sub
Udik, и ещё раз спасибо! :) Пока не проверяю, некогда, но похоже всё должно работать.
Пожалуй задам ещё один вопрос. Скорее не по необходимости, а "красоты кода для". Стоит ли заморачиваться верхним динамическим пределом? Или по другому, для этого макроса будет тяжело обрабатывать 5-10 тыс строк?
По поводу формата Дата, то какая-то странная ситуация. Я их форматировал в короткий вид... и вы тоже форматировали... а после я опять форматировал. Похоже тут какие-то нюансы независящие от нас.
Udik, и ещё раз спасибо! :) Пока не проверяю, некогда, но похоже всё должно работать.
Пожалуй задам ещё один вопрос. Скорее не по необходимости, а "красоты кода для". Стоит ли заморачиваться верхним динамическим пределом? Или по другому, для этого макроса будет тяжело обрабатывать 5-10 тыс строк?
По поводу формата Дата, то какая-то странная ситуация. Я их форматировал в короткий вид... и вы тоже форматировали... а после я опять форматировал. Похоже тут какие-то нюансы независящие от нас. Кравченко
"не понял, налей..." Пытаюсь расшифровать Если будет тормозить, то проблема не только в одном макросе. Такой макрос выполнит пол миллиона операций за... учитывая процессор... переводя в машинные коды... учитывая текущую загрузку компа и сети... учитывая... В общем, если говорить абсолютно точно, то достаточно быстро. Я правильно понял?
"не понял, налей..." Пытаюсь расшифровать Если будет тормозить, то проблема не только в одном макросе. Такой макрос выполнит пол миллиона операций за... учитывая процессор... переводя в машинные коды... учитывая текущую загрузку компа и сети... учитывая... В общем, если говорить абсолютно точно, то достаточно быстро. Я правильно понял? Кравченко
Там от многих вещей зависит, просто во время работы макроса сам эксель по-умолчанию много неактуального делает, вот это и отключают типа такого: [vba]
Код
Public Sub uskorRadio(flag As Boolean) 'обновл. страницы после каждого действия Application.ScreenUpdating = flag
'ручной режим расчётов If flag Then Application.Calculation = xlCalculationAutomatic Else Application.Calculation = xlCalculationManual End If
'события Application.EnableEvents = flag
'показ разрывов страниц If Workbooks.Count Then ActiveWorkbook.ActiveSheet.DisplayPageBreaks = flag End If
'статусная строка Application.DisplayStatusBar = flag
'сообщения Excel Application.DisplayAlerts = flag
End Sub
[/vba] На всякий случай дополнительно повесил включение на открытие книги (на случай нештатного завершения макроса). Но само отключение/включение с обновлением может отнять несколько секнд, поэтому если и без этого время обработки маленькое, можно не отключать.
Там от многих вещей зависит, просто во время работы макроса сам эксель по-умолчанию много неактуального делает, вот это и отключают типа такого: [vba]
Код
Public Sub uskorRadio(flag As Boolean) 'обновл. страницы после каждого действия Application.ScreenUpdating = flag
'ручной режим расчётов If flag Then Application.Calculation = xlCalculationAutomatic Else Application.Calculation = xlCalculationManual End If
'события Application.EnableEvents = flag
'показ разрывов страниц If Workbooks.Count Then ActiveWorkbook.ActiveSheet.DisplayPageBreaks = flag End If
'статусная строка Application.DisplayStatusBar = flag
'сообщения Excel Application.DisplayAlerts = flag
End Sub
[/vba] На всякий случай дополнительно повесил включение на открытие книги (на случай нештатного завершения макроса). Но само отключение/включение с обновлением может отнять несколько секнд, поэтому если и без этого время обработки маленькое, можно не отключать.Udik
Спросил на свою голову сейчас разбирайся как влияет на быстродействие разные "фишки" типа разрыва страниц. В общем заморачиваться верхним пределом пока не стоит. А будущее покажет. Еще раз спасибо за помощь.
Спросил на свою голову сейчас разбирайся как влияет на быстродействие разные "фишки" типа разрыва страниц. В общем заморачиваться верхним пределом пока не стоит. А будущее покажет. Еще раз спасибо за помощь.Кравченко
Сообщение отредактировал Кравченко - Пятница, 26.02.2016, 22:56