Здравствуйте! Помогите, пожалуйста, написать макрос. Имеется таблица, формата: <2022-11-28> дата <...> произвольная запись <...> <...> <2022-11-28> <...> <...> <...> Всё расположено в столбце B Нужно: если в ячейке В - дата, то перенести в ячейку J со смещением на одну строку вниз. Например B2 -> J3, B10 -> J11. В таблице длина столбца В нерегулярная, от 20 000 до 140 000.
Как я вижу алгоритм: Если в В i есть данные, то (Если в В i "Дата", то перенести в J i+1, иначе перейти к B i+1), иначе завершить.
Здравствуйте! Помогите, пожалуйста, написать макрос. Имеется таблица, формата: <2022-11-28> дата <...> произвольная запись <...> <...> <2022-11-28> <...> <...> <...> Всё расположено в столбце B Нужно: если в ячейке В - дата, то перенести в ячейку J со смещением на одну строку вниз. Например B2 -> J3, B10 -> J11. В таблице длина столбца В нерегулярная, от 20 000 до 140 000.
Как я вижу алгоритм: Если в В i есть данные, то (Если в В i "Дата", то перенести в J i+1, иначе перейти к B i+1), иначе завершить.JimDG
А можете файл без макросов приложить? У меня на работе блокировка безопасности стоит, не могу скачивать. Ну, или подождите того, у кого нормально с этим
А можете файл без макросов приложить? У меня на работе блокировка безопасности стоит, не могу скачивать. Ну, или подождите того, у кого нормально с этим_Boroda_
Сделал вот так(для примера взял 63 строки в обработку. В рабочем файле количество строк будет варьироваться, потому условие наличия данных в ячейке нужно для завершения цикла): [vba]
Код
Dim i As Long For i = 1 To 63 If IsEmpty(Cells(i, 2)) = False Then If IsDate(Cells(i, 2)) = True Then Selection.Copy Cells(i + 1, 10) Selection.ClearContents Else End If Else End If Next i End Sub
[/vba]
Но он отрабатывает только если я конкретно выделил ячейку с датой, и каждый раз вручную активирую макрос, переносит. То есть, в данном случае срабатывает только конструкция [vba]
В рабочем файле порядка 50 000 строк, из них с датами только около 700-800. Нужно чтоб он последовательно обработал каждую строку и перенес даты в другую колонку.
Надеюсь, я правильно составил алгоритм, чтоб разбить задачу на более мелкие: 1. Объявляем переменную i=1 2. Проверяем Cells(i, 2): пустая? 2.1 Если да: завешаем работу макроса 2.1 Если нет: 3. Проверяем формат данных в ячейке 3.1 Если да: копируем из ячейки Cells(i, 2) в ячейку Cells(i+1, 10), переходим к пункту 2. 3.2. Если нет: переходим в ячейку Cells(i+1, 2)переходим к пункту 2.
Как-то так
Сделал вот так(для примера взял 63 строки в обработку. В рабочем файле количество строк будет варьироваться, потому условие наличия данных в ячейке нужно для завершения цикла): [vba]
Код
Dim i As Long For i = 1 To 63 If IsEmpty(Cells(i, 2)) = False Then If IsDate(Cells(i, 2)) = True Then Selection.Copy Cells(i + 1, 10) Selection.ClearContents Else End If Else End If Next i End Sub
[/vba]
Но он отрабатывает только если я конкретно выделил ячейку с датой, и каждый раз вручную активирую макрос, переносит. То есть, в данном случае срабатывает только конструкция [vba]
В рабочем файле порядка 50 000 строк, из них с датами только около 700-800. Нужно чтоб он последовательно обработал каждую строку и перенес даты в другую колонку.
Надеюсь, я правильно составил алгоритм, чтоб разбить задачу на более мелкие: 1. Объявляем переменную i=1 2. Проверяем Cells(i, 2): пустая? 2.1 Если да: завешаем работу макроса 2.1 Если нет: 3. Проверяем формат данных в ячейке 3.1 Если да: копируем из ячейки Cells(i, 2) в ячейку Cells(i+1, 10), переходим к пункту 2. 3.2. Если нет: переходим в ячейку Cells(i+1, 2)переходим к пункту 2.
Sub tt() c0_ = 2 'столбец откуда c1_ = 10 'столбец куда r0_ = 1 'первая строка nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ + 1 'кол-во строк в столбце Откуда Cells(r0_, c1_).Resize(Cells(Rows.Count, c1_).End(3).Row).ClearContents 'очищаем Куда ar0_ = Cells(r0_, c0_).Resize(nr_).Value 'массив Откуда ar1_ = Cells(r0_, c1_).Resize(nr_).Value 'массив Куда (сейчас пустой) For i = 1 To nr_'цикл по строкам (в массиве, не на листе!!!. Так намного быстрее) If IsDate(ar0_(i, 1)) Then' если дата ar1_(i, 1) = ar0_(i, 1)' Присваиваем второму массиву значение первого (в строке i) End If Next i Cells(r0_ + 1, c1_).Resize(nr_).Value = ar1_' Выгружаем второй массив на лист. Со строки на одну ниже End Sub
[/vba]
[vba]
Код
Sub tt() c0_ = 2 'столбец откуда c1_ = 10 'столбец куда r0_ = 1 'первая строка nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ + 1 'кол-во строк в столбце Откуда Cells(r0_, c1_).Resize(Cells(Rows.Count, c1_).End(3).Row).ClearContents 'очищаем Куда ar0_ = Cells(r0_, c0_).Resize(nr_).Value 'массив Откуда ar1_ = Cells(r0_, c1_).Resize(nr_).Value 'массив Куда (сейчас пустой) For i = 1 To nr_'цикл по строкам (в массиве, не на листе!!!. Так намного быстрее) If IsDate(ar0_(i, 1)) Then' если дата ar1_(i, 1) = ar0_(i, 1)' Присваиваем второму массиву значение первого (в строке i) End If Next i Cells(r0_ + 1, c1_).Resize(nr_).Value = ar1_' Выгружаем второй массив на лист. Со строки на одну ниже End Sub
Макрос заработал, достаточно было вручную его переписать, а не копипастить. Как ни странно. Дополнил его работу макросом [vba]
Код
Sub Удалить_пустые_строки() collJ_ = Cells(Rows.Count, 10).End(3).Row - r0_ + 1 For i = collJ_ To 1 Step -1 If Cells(i, 10) = "" Then Cells(i, 10).EntireRow.Delete End If Next i End Sub
[/vba]
На 23400 строк операция заняла 17 минут, против 7 часов вручную. Спасибо большое за помощь. Впервые столкнулся с макросами. Понял, насколько интересное направление) Буду дальше развиваться в этом направлении
Макрос заработал, достаточно было вручную его переписать, а не копипастить. Как ни странно. Дополнил его работу макросом [vba]
Код
Sub Удалить_пустые_строки() collJ_ = Cells(Rows.Count, 10).End(3).Row - r0_ + 1 For i = collJ_ To 1 Step -1 If Cells(i, 10) = "" Then Cells(i, 10).EntireRow.Delete End If Next i End Sub
[/vba]
На 23400 строк операция заняла 17 минут, против 7 часов вручную. Спасибо большое за помощь. Впервые столкнулся с макросами. Понял, насколько интересное направление) Буду дальше развиваться в этом направленииJimDG
Скока???? Должно за пару секунд отрабатывать. Вы работаете с ячейками, а нужно этот момент минимизировать. Ну, допустим, удалить именно строки (и если, при этом, у Вас таблица с кучей разных форматов, а не просто данные), да, придется по очереди. Хот нет, не обязательно, можно и всей кучей. Но это немного непонятно Вам пока с кодом будет А пока в самое начало макроса напишите отключение обновления экрана и пересчета. А внизу обратно включите Вот так примерно [vba]
Код
Sub Makros_() Application.ScreenUpdating = 0 Application.Calculation = 3
'Текст макроса
Application.ScreenUpdating = 1 Application.Calculation = 1 End Sub
Скока???? Должно за пару секунд отрабатывать. Вы работаете с ячейками, а нужно этот момент минимизировать. Ну, допустим, удалить именно строки (и если, при этом, у Вас таблица с кучей разных форматов, а не просто данные), да, придется по очереди. Хот нет, не обязательно, можно и всей кучей. Но это немного непонятно Вам пока с кодом будет А пока в самое начало макроса напишите отключение обновления экрана и пересчета. А внизу обратно включите Вот так примерно [vba]
Код
Sub Makros_() Application.ScreenUpdating = 0 Application.Calculation = 3
'Текст макроса
Application.ScreenUpdating = 1 Application.Calculation = 1 End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
