Здравствуйте. Есть макрос который объединяет Все одинаковые значения в таблице ексель: Сам макрос: [vba]
Код
Sub JoinDoubles() Dim i As Long Dim j As Long Application.DisplayAlerts = False For j = 1 To Selection.Columns.Count For i = Selection.Rows.Count To 2 Step -1 If Selection.Cells(i - 1, j) = Selection.Cells(i, j) Then Range(Selection.Cells(i - 1, j), Selection.Cells(i, j)).Merge End If Next Next Selection.VerticalAlignment = xlVAlignCenter Application.DisplayAlerts = True End Sub
[/vba] Макрос классный, но есть нюанс, как сделать чтоб объединение происходило только по определённым столбцам? И чтоб не нужно было выделять таблицу ( без выделений макрос не работает.
Так же, есть макрос который вставляет пустые строки: [vba]
Код
Sub VstavkaStrok1() Dim i As Long Dim pustroka As Long For i = Selection.Rows.Count To 2 Step -1 If Selection(i, 1).MergeArea.Rows.Count <> 1 Then pustroka = Selection(i, 1).Row + 1 ActiveSheet.Rows(pustroka).Insert xlShiftDown ActiveSheet.Rows(pustroka).RowHeight = 7 ActiveSheet.Rows(pustroka).Borders(xlInsideVertical). _ LineStyle = xlLineStyleNone ActiveSheet.Rows(pustroka).Borders(xlEdgeLeft). _ LineStyle = xlLineStyleNone ActiveSheet.Rows(pustroka).Borders(xlEdgeRight). _ LineStyle = xlLineStyleNone ActiveSheet.Rows(pustroka).Interior. _ ColorIndex = xlColorIndexNone i = i - Selection(i, 1).MergeArea.Rows.Count + 1 End If Next End Sub
[/vba] Помогите объединить эти два макроса в один, чтоб получилось так: Мы на активной странице запускаем макрос (без выделения таблицы), он объединяет все одинаковые значения по столбцу B и после объедения, вставлялась строчка (после каждого объединившегося блока) И еще, эти макросы работаю в обычной таблице. А как сделать чтоб пахали в умной таблице? Спасибо кто поможет.
Здравствуйте. Есть макрос который объединяет Все одинаковые значения в таблице ексель: Сам макрос: [vba]
Код
Sub JoinDoubles() Dim i As Long Dim j As Long Application.DisplayAlerts = False For j = 1 To Selection.Columns.Count For i = Selection.Rows.Count To 2 Step -1 If Selection.Cells(i - 1, j) = Selection.Cells(i, j) Then Range(Selection.Cells(i - 1, j), Selection.Cells(i, j)).Merge End If Next Next Selection.VerticalAlignment = xlVAlignCenter Application.DisplayAlerts = True End Sub
[/vba] Макрос классный, но есть нюанс, как сделать чтоб объединение происходило только по определённым столбцам? И чтоб не нужно было выделять таблицу ( без выделений макрос не работает.
Так же, есть макрос который вставляет пустые строки: [vba]
Код
Sub VstavkaStrok1() Dim i As Long Dim pustroka As Long For i = Selection.Rows.Count To 2 Step -1 If Selection(i, 1).MergeArea.Rows.Count <> 1 Then pustroka = Selection(i, 1).Row + 1 ActiveSheet.Rows(pustroka).Insert xlShiftDown ActiveSheet.Rows(pustroka).RowHeight = 7 ActiveSheet.Rows(pustroka).Borders(xlInsideVertical). _ LineStyle = xlLineStyleNone ActiveSheet.Rows(pustroka).Borders(xlEdgeLeft). _ LineStyle = xlLineStyleNone ActiveSheet.Rows(pustroka).Borders(xlEdgeRight). _ LineStyle = xlLineStyleNone ActiveSheet.Rows(pustroka).Interior. _ ColorIndex = xlColorIndexNone i = i - Selection(i, 1).MergeArea.Rows.Count + 1 End If Next End Sub
[/vba] Помогите объединить эти два макроса в один, чтоб получилось так: Мы на активной странице запускаем макрос (без выделения таблицы), он объединяет все одинаковые значения по столбцу B и после объедения, вставлялась строчка (после каждого объединившегося блока) И еще, эти макросы работаю в обычной таблице. А как сделать чтоб пахали в умной таблице? Спасибо кто поможет. baskakova7441
как сделать чтоб объединение происходило только по определённым столбцам?
Самое простое - "проложить" циклы Select Case'м с указанием номеров столбцов срабатывания: [vba]
Код
Sub JoinDoubles() Dim i As Long Dim j As Long Application.DisplayAlerts = False For j = 1 To Selection.Columns.Count Select Case j 'вот это добавить - 1 Case 3 To 7 'ещё вот это - 2 For i = Selection.Rows.Count To 2 Step -1 If Selection.Cells(i - 1, j) = Selection.Cells(i, j) Then Range(Selection.Cells(i - 1, j), Selection.Cells(i, j)).Merge End If Next End Select 'и вот это - 3 Next Selection.VerticalAlignment = xlVAlignCenter Application.DisplayAlerts = True End Sub
как сделать чтоб объединение происходило только по определённым столбцам?
Самое простое - "проложить" циклы Select Case'м с указанием номеров столбцов срабатывания: [vba]
Код
Sub JoinDoubles() Dim i As Long Dim j As Long Application.DisplayAlerts = False For j = 1 To Selection.Columns.Count Select Case j 'вот это добавить - 1 Case 3 To 7 'ещё вот это - 2 For i = Selection.Rows.Count To 2 Step -1 If Selection.Cells(i - 1, j) = Selection.Cells(i, j) Then Range(Selection.Cells(i - 1, j), Selection.Cells(i, j)).Merge End If Next End Select 'и вот это - 3 Next Selection.VerticalAlignment = xlVAlignCenter Application.DisplayAlerts = True End Sub
RAN, Gustav, Pelena, ребята, подскажите как в моем случае сделать так: чтоб при добавление данных через форму, они добавлялись с рамками и от центрованы
RAN, Gustav, Pelena, ребята, подскажите как в моем случае сделать так: чтоб при добавление данных через форму, они добавлялись с рамками и от центрованыbaskakova7441