Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос на поиск строк, объединение ячеек, выравнивание - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос на поиск строк, объединение ячеек, выравнивание (Макросы/Sub)
Макрос на поиск строк, объединение ячеек, выравнивание
falazure123 Дата: Четверг, 05.11.2020, 10:13 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Добрый день.
Помогите, пожалуйста, с макросом.

Нужно написать макрос, который:
1) идёт по строкам, начиная с 13.
2) выполняет проверку: если столбец B пустой, то объединить ячейки с A по Z, выровнять содержимое по левому краю. (если не очень сложно, то дополнительно у строки сделать толстые внешние границы).
И так для каждой такой найденной строки. (нужно понять как выйти из цикла).

(ну или может можно макрос написать оптимальнее. Не через цикл по строкам, а через поиск и выделение таких строк и дальше объединение + выравнивание. Это, наверное, должно быстрее работать, чем цикл).

Во вложении файл, который формируется сейчас - before.xls.
И пример файла, который должен получиться после выполнения макроса - after.xls
К сообщению приложен файл: after.xls (51.0 Kb) · before.xls (50.0 Kb)
 
Ответить
СообщениеДобрый день.
Помогите, пожалуйста, с макросом.

Нужно написать макрос, который:
1) идёт по строкам, начиная с 13.
2) выполняет проверку: если столбец B пустой, то объединить ячейки с A по Z, выровнять содержимое по левому краю. (если не очень сложно, то дополнительно у строки сделать толстые внешние границы).
И так для каждой такой найденной строки. (нужно понять как выйти из цикла).

(ну или может можно макрос написать оптимальнее. Не через цикл по строкам, а через поиск и выделение таких строк и дальше объединение + выравнивание. Это, наверное, должно быстрее работать, чем цикл).

Во вложении файл, который формируется сейчас - before.xls.
И пример файла, который должен получиться после выполнения макроса - after.xls

Автор - falazure123
Дата добавления - 05.11.2020 в 10:13
Hugo Дата: Четверг, 05.11.2020, 11:06 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3250
Репутация: 707 ±
Замечаний: 0% ±

2019
Добрый день.
На 3 строки долго не будет, можно даже не отключать обновление экрана.
Вот, используя макрорекордер (обработка в чистом виде запись рекордера, специально ничего не выкидывал, только заменил selection на аргумент):


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Четверг, 05.11.2020, 11:10
 
Ответить
СообщениеДобрый день.
На 3 строки долго не будет, можно даже не отключать обновление экрана.
Вот, используя макрорекордер (обработка в чистом виде запись рекордера, специально ничего не выкидывал, только заменил selection на аргумент):

Автор - Hugo
Дата добавления - 05.11.2020 в 11:06
falazure123 Дата: Четверг, 05.11.2020, 11:15 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Добрый день.
На 3 строки долго не будет, можно даже не отключать обновление экрана.
Вот, используя макрорекордер (обработка в чистом виде запись рекордера, специально ничего не выкидывал, только заменил selection на аргумент):


В том и дело , что строк может быть сколько угодно (выгружаются данные из системы). Это для примера скинул файлы.
 
Ответить
Сообщение
Добрый день.
На 3 строки долго не будет, можно даже не отключать обновление экрана.
Вот, используя макрорекордер (обработка в чистом виде запись рекордера, специально ничего не выкидывал, только заменил selection на аргумент):


В том и дело , что строк может быть сколько угодно (выгружаются данные из системы). Это для примера скинул файлы.

Автор - falazure123
Дата добавления - 05.11.2020 в 11:15
Nic70y Дата: Четверг, 05.11.2020, 12:50 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 8705
Репутация: 2260 ±
Замечаний: 0% ±

Excel 2010
не по тексту
[vba]
Код
Sub u_800()
    Application.ScreenUpdating = False 'отключение обновления экрана
    ua = Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A
    If ua > 19 Then 'если есть строки для проверки, выполняем (19 = 12 + 7(итоговые строки))
        ua = ua - 7 'отсекаем итоговые строки
        ub = Application.CountIf(Range("a13:a" & ua), "*") 'считаем кол-во строк с текстом (т.к. остальное числа)
        If ub > 0 Then 'если строки с текстом есть, пройдемся по ним циклом
            uc = 13 'начальная* строка поиска
            For ud = 1 To ub
                ue = Application.Match("*", Range("a" & uc & ":a" & ua), 0) 'ищем строку с текстом
                uf = ue + uc - 1 'номер строки с текстом
                uc = uf + 1 'следующая* строка поиска
                Range("a" & uf & ":z" & uf).Merge 'объединение ячеек в строке
                Range("a" & uf & ":z" & uf).HorizontalAlignment = xlLeft 'по левому краю
                Range("a" & uf & ":z" & uf).Borders(xlEdgeLeft).Weight = xlMedium 'границы
                Range("a" & uf & ":z" & uf).Borders(xlEdgeRight).Weight = xlMedium
                Range("a" & uf & ":z" & uf).Borders(xlEdgeTop).Weight = xlMedium
                Range("a" & uf & ":z" & uf).Borders(xlEdgeBottom).Weight = xlMedium
            Next ud
        End If
    End If
    Application.ScreenUpdating = True 'включение обновления экрана
End Sub
[/vba]


ЮMoney 41001841029809
 
Ответить
Сообщениене по тексту
[vba]
Код
Sub u_800()
    Application.ScreenUpdating = False 'отключение обновления экрана
    ua = Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A
    If ua > 19 Then 'если есть строки для проверки, выполняем (19 = 12 + 7(итоговые строки))
        ua = ua - 7 'отсекаем итоговые строки
        ub = Application.CountIf(Range("a13:a" & ua), "*") 'считаем кол-во строк с текстом (т.к. остальное числа)
        If ub > 0 Then 'если строки с текстом есть, пройдемся по ним циклом
            uc = 13 'начальная* строка поиска
            For ud = 1 To ub
                ue = Application.Match("*", Range("a" & uc & ":a" & ua), 0) 'ищем строку с текстом
                uf = ue + uc - 1 'номер строки с текстом
                uc = uf + 1 'следующая* строка поиска
                Range("a" & uf & ":z" & uf).Merge 'объединение ячеек в строке
                Range("a" & uf & ":z" & uf).HorizontalAlignment = xlLeft 'по левому краю
                Range("a" & uf & ":z" & uf).Borders(xlEdgeLeft).Weight = xlMedium 'границы
                Range("a" & uf & ":z" & uf).Borders(xlEdgeRight).Weight = xlMedium
                Range("a" & uf & ":z" & uf).Borders(xlEdgeTop).Weight = xlMedium
                Range("a" & uf & ":z" & uf).Borders(xlEdgeBottom).Weight = xlMedium
            Next ud
        End If
    End If
    Application.ScreenUpdating = True 'включение обновления экрана
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 05.11.2020 в 12:50
Hugo Дата: Четверг, 05.11.2020, 20:13 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3250
Репутация: 707 ±
Замечаний: 0% ±

2019
Можно так ускориться:

Есть ещё резерв - анализируем/перебираем массив. Ну это заметно сыграет если строк где-то более 10к уже...


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Четверг, 05.11.2020, 20:14
 
Ответить
СообщениеМожно так ускориться:

Есть ещё резерв - анализируем/перебираем массив. Ну это заметно сыграет если строк где-то более 10к уже...

Автор - Hugo
Дата добавления - 05.11.2020 в 20:13
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос на поиск строк, объединение ячеек, выравнивание (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!