Здравствуйте, не могу решить одну задачу, нужно объединить ячейки без потери данных после нажатия условной кнопки, данные хранятся на столбцах 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