Нужна Ваша помощь с написанием макроса. Есть прайс, где наименование категорий находятся в столбце "А", а остальные семь строк равны нулю, нужно сделать объединение всех восьми строк, с сохранением текста из первой, и фон залить желтым цветом, как указано в примере (файл с наименованием finish). Исходник (файл с наименованием start) и пример (файл с наименованием finish) прилагаю.
В интернете нарыл что-то похожее, но как ни пытался переделать, ничего не вышло.
[vba]
Код
Sub MergeCls() Dim ri As Integer, r2 As Integer, Col As Integer r1 = ActiveCell.Row r2 = ActiveCell.Row Col = ActiveCell.Column Do If Cells(r1, Col) <> Cells(r2 + 1, Col) Then If r1 <> r2 Then Range(Cells(r1 + 1, Col), Cells(r2, Col)).ClearContents With Range(Cells(r1, Col), Cells(r2, Col)) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With End If r1 = r2 + 1 End If r2 = r2 + 1 Loop Until Cells(r2, Col) = "" End Su
[/vba]
Надеюсь и рассчитываю на Вашу помощь в решении такой сложной задачи.
Всем доброго времени суток!
Нужна Ваша помощь с написанием макроса. Есть прайс, где наименование категорий находятся в столбце "А", а остальные семь строк равны нулю, нужно сделать объединение всех восьми строк, с сохранением текста из первой, и фон залить желтым цветом, как указано в примере (файл с наименованием finish). Исходник (файл с наименованием start) и пример (файл с наименованием finish) прилагаю.
В интернете нарыл что-то похожее, но как ни пытался переделать, ничего не вышло.
[vba]
Код
Sub MergeCls() Dim ri As Integer, r2 As Integer, Col As Integer r1 = ActiveCell.Row r2 = ActiveCell.Row Col = ActiveCell.Column Do If Cells(r1, Col) <> Cells(r2 + 1, Col) Then If r1 <> r2 Then Range(Cells(r1 + 1, Col), Cells(r2, Col)).ClearContents With Range(Cells(r1, Col), Cells(r2, Col)) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With End If r1 = r2 + 1 End If r2 = r2 + 1 Loop Until Cells(r2, Col) = "" End Su
[/vba]
Надеюсь и рассчитываю на Вашу помощь в решении такой сложной задачи.force
With ThisWorkbook.Worksheets("Data") X = 3 Do While .Cells(X, 1).Value <> "" Debug.Print "Cell " & X If Not IsNumeric(.Cells(X, 1).Value) Then With .Range(.Cells(X, 1), .Cells(X, 8)) .MergeCells = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Bold = True .Interior.Color = 65535 .Borders(xlEdgeLeft).Weight = xlThin .Borders(xlEdgeTop).Weight = xlThin .Borders(xlEdgeBottom).Weight = xlThin .Borders(xlEdgeRight).Weight = xlThin End With End If X = X + 1 Loop End With
With ThisWorkbook.Worksheets("Data") X = 3 Do While .Cells(X, 1).Value <> "" Debug.Print "Cell " & X If Not IsNumeric(.Cells(X, 1).Value) Then With .Range(.Cells(X, 1), .Cells(X, 8)) .MergeCells = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Bold = True .Interior.Color = 65535 .Borders(xlEdgeLeft).Weight = xlThin .Borders(xlEdgeTop).Weight = xlThin .Borders(xlEdgeBottom).Weight = xlThin .Borders(xlEdgeRight).Weight = xlThin End With End If X = X + 1 Loop End With
Ну, я понимаю, когда без макроса никак, но в этом-то случае зачем плодить лишнее? Ведь всё элементарно делается: 1. Автофильтром выделяете те строки, где в столбце В 0 (ну, для верности можно ещё и по другим столбцам 0 фильтрануть) 2. Выделяете отфильтрованные заголовки и делаете "Объединить по строкам".
Ну, я понимаю, когда без макроса никак, но в этом-то случае зачем плодить лишнее? Ведь всё элементарно делается: 1. Автофильтром выделяете те строки, где в столбце В 0 (ну, для верности можно ещё и по другим столбцам 0 фильтрануть) 2. Выделяете отфильтрованные заголовки и делаете "Объединить по строкам".Alex_ST
1. Автофильтром выделяете те строки, где в столбце В 0 (ну, для верности можно ещё и по другим столбцам 0 фильтрануть)
А после этого ВЫДЕЛИТЬ ВСЁ ОТФИЛЬТРОВАННОЕ и выполнить "Объединить по строкам"? Ну, единственно, что придётся сделать, так это столько раз, сколько у Вас будет строк заголовков, согласиться с тем, что при объединении данные затрутся. Хотя и этого можно избежать если в отфильтрованных заголовках сначала перед объединением по строкам выделить всё, что правее столбца А, и стереть его. Тогда там будут не нули, а пустышки и про их стирание при объединении Excel кричать не будет.
1. Автофильтром выделяете те строки, где в столбце В 0 (ну, для верности можно ещё и по другим столбцам 0 фильтрануть)
А после этого ВЫДЕЛИТЬ ВСЁ ОТФИЛЬТРОВАННОЕ и выполнить "Объединить по строкам"? Ну, единственно, что придётся сделать, так это столько раз, сколько у Вас будет строк заголовков, согласиться с тем, что при объединении данные затрутся. Хотя и этого можно избежать если в отфильтрованных заголовках сначала перед объединением по строкам выделить всё, что правее столбца А, и стереть его. Тогда там будут не нули, а пустышки и про их стирание при объединении Excel кричать не будет.Alex_ST
Alex_ST, действительно все просто , но все это занимает время, с макросом все гораздо веселее. Rioran очень выручил, я его макрос уже применил еще в нескольких прайсах. Всем, кто помогал, ОГРОМНОЕ спасибо! Очень приятно, когда помогают такие профессионалы, не оставляют в беде...
Alex_ST, действительно все просто , но все это занимает время, с макросом все гораздо веселее. Rioran очень выручил, я его макрос уже применил еще в нескольких прайсах. Всем, кто помогал, ОГРОМНОЕ спасибо! Очень приятно, когда помогают такие профессионалы, не оставляют в беде... force
Дело в том, что в одном файле нужно объединять 8 строк, в другом 6 и тд..., в каждом прайсе разное количество столбцов, поэтому я макрос под каждый прайс подгоняю.
Дело в том, что в одном файле нужно объединять 8 строк, в другом 6 и тд..., в каждом прайсе разное количество столбцов, поэтому я макрос под каждый прайс подгоняю.force
Ну уж это совсем не проблема: выведите сначала запрос о количестве строк. Да и объединять лучше тогда не с третьей строки начиная, а с запрашиваемой или с той, которая выделена при запуске макроса (можно и её попросить ткнуть в диалоговом окне)
Ну уж это совсем не проблема: выведите сначала запрос о количестве строк. Да и объединять лучше тогда не с третьей строки начиная, а с запрашиваемой или с той, которая выделена при запуске макроса (можно и её попросить ткнуть в диалоговом окне)Alex_ST
[offtop]Что-то уж очень не добрый ты, Андрей, в 2 часа ночи… И вообще, ребята, вы что, все в отпусках что ли и утром на работу не вставать?[/offtop]
[offtop]Что-то уж очень не добрый ты, Андрей, в 2 часа ночи… И вообще, ребята, вы что, все в отпусках что ли и утром на работу не вставать?[/offtop]Alex_ST
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Я за Вами не успеваю 
