Помогите.... Есть таблица (прилагаю) необходимо по нажатию кнопки объединить ячейки по условию (если совпадают значения ячеек в другом столбце) Книга1.xls(22 КБ)
Макрос сделан для листа, который во вложенном файле. То есть данные начинаются со строки 1, а под таблицей нет других данных.
Макрос
Код
Sub Объединить()
Dim arr(), lr As Long, i As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "A").End(xlUp).row
arr() = Range("B1:B" & lr).Value
Application.DisplayAlerts = False
For i = UBound(arr) To 2 Step -1
If arr(i, 1) = arr(i - 1, 1) Then
Cells(i - 1, "D").Resize(2).Merge
Cells(i - 1, "D").VerticalAlignment = xlCenter
End If
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Объединить()
Dim arr(), lr As Long, i As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "A").End(xlUp).Row
arr() = Range("B1:B" & lr).Value
Application.DisplayAlerts = False
For i = UBound(arr) To 8 Step -1
If arr(i, 1) = arr(i - 1, 1) Then
Cells(i - 1, "D").Resize(2).Merge
Cells(i - 1, "D").VerticalAlignment = xlCenter
End If
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub