Здравствуйте, не могу решить одну задачу, нужно объединить ячейки без потери данных после нажатия условной кнопки, данные хранятся на столбцах D,E,F,G количество строк всегда меняется, поэтому желательно чтобы макрос заканчивал объединять на последней строке, также есть несколько объединённых ячеек, с которыми ничего не надо делать, но после них тоже идут данные в ячейках, которые тоже нужно объединять, для понимания прикрепил файл. Я нашел был макрос, но он объединяет только указанный диапазон. Заранее спасибо!!!
Здравствуйте, не могу решить одну задачу, нужно объединить ячейки без потери данных после нажатия условной кнопки, данные хранятся на столбцах D,E,F,G количество строк всегда меняется, поэтому желательно чтобы макрос заканчивал объединять на последней строке, также есть несколько объединённых ячеек, с которыми ничего не надо делать, но после них тоже идут данные в ячейках, которые тоже нужно объединять, для понимания прикрепил файл. Я нашел был макрос, но он объединяет только указанный диапазон. Заранее спасибо!!!albertikhsanov00
Sub ObedinitGorizontal() lr = Cells(Rows.Count, 4).End(xlUp).Row Range("$D$2:$G$" & lr).Select Dim savetext As String Application.DisplayAlerts = False For k = 1 To Selection.Areas.Count For i = 1 To Selection.Areas(k).Rows.Count savetext = Selection.Areas(k).Cells(i, 1) For j = 2 To Selection.Areas(k).Columns.Count savetext = savetext & Chr(32) & Selection.Areas(k).Cells(i, j) Next Selection.Areas(k).Rows(i).Merge Selection.Areas(k).Cells(i, 1) = savetext Selection.Areas(k).Cells(i, 1).HorizontalAlignment = xlHAlignCenter Next Next Application.DisplayAlerts = True End Sub
Sub ObedinitGorizontal() lr = Cells(Rows.Count, 4).End(xlUp).Row Range("$D$2:$G$" & lr).Select Dim savetext As String Application.DisplayAlerts = False For k = 1 To Selection.Areas.Count For i = 1 To Selection.Areas(k).Rows.Count savetext = Selection.Areas(k).Cells(i, 1) For j = 2 To Selection.Areas(k).Columns.Count savetext = savetext & Chr(32) & Selection.Areas(k).Cells(i, j) Next Selection.Areas(k).Rows(i).Merge Selection.Areas(k).Cells(i, 1) = savetext Selection.Areas(k).Cells(i, 1).HorizontalAlignment = xlHAlignCenter Next Next Application.DisplayAlerts = True End Sub
Sub ObedinitGorizontal_1() lr = Cells(Rows.Count, 4).End(xlUp).Row Dim savetext As String Application.DisplayAlerts = False For k = 2 To lr If Cells(k, 4).MergeCells = False Then savetext = Cells(k, 4) & Chr(32) & Cells(k, 5) & Chr(32) & Cells(k, 6) & Chr(32) & Cells(k, 7) Range(Cells(k, 4), Cells(k, 7)).Merge Cells(k, 4) = savetext Cells(k, 4).HorizontalAlignment = xlHAlignCenter End If Next Application.DisplayAlerts = True End Sub
[/vba]
Ну тогда так [vba]
Код
Sub ObedinitGorizontal_1() lr = Cells(Rows.Count, 4).End(xlUp).Row Dim savetext As String Application.DisplayAlerts = False For k = 2 To lr If Cells(k, 4).MergeCells = False Then savetext = Cells(k, 4) & Chr(32) & Cells(k, 5) & Chr(32) & Cells(k, 6) & Chr(32) & Cells(k, 7) Range(Cells(k, 4), Cells(k, 7)).Merge Cells(k, 4) = savetext Cells(k, 4).HorizontalAlignment = xlHAlignCenter End If Next Application.DisplayAlerts = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
