Версия для слабовидящих
Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

 

= Мир MS Excel/Объединения одинаковых значений и вставка строки - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Объединения одинаковых значений и вставка строки
baskakova7441 Дата: Суббота, 28.08.2021, 10:18 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Здравствуйте. Есть макрос который объединяет Все одинаковые значения в таблице ексель:
Сам макрос:

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


Макрос классный, но есть нюанс, как сделать чтоб объединение происходило только по определённым столбцам? И чтоб не нужно было выделять таблицу ( без выделений макрос не работает.

Так же, есть макрос который вставляет пустые строки:

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


Помогите объединить эти два макроса в один, чтоб получилось так:
Мы на активной странице запускаем макрос (без выделения таблицы), он объединяет все одинаковые значения по столбцу B и после объедения, вставлялась строчка (после каждого объединившегося блока)
И еще, эти макросы работаю в обычной таблице. А как сделать чтоб пахали в умной таблице? Спасибо кто поможет.
 
Ответить
СообщениеЗдравствуйте. Есть макрос который объединяет Все одинаковые значения в таблице ексель:
Сам макрос:
[vba]
Sub JoinDoubles()Dim i As LongDim j As LongApplication.DisplayAlerts = FalseFor 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  NextNextSelection.VerticalAlignment = xlVAlignCenterApplication.DisplayAlerts = ТrueEnd Sub
[/vba]
Макрос классный, но есть нюанс, как сделать чтоб объединение происходило только по определённым столбцам? И чтоб не нужно было выделять таблицу ( без выделений макрос не работает.

Так же, есть макрос который вставляет пустые строки:
[vba]
Sub VstavkaStrok1()Dim i As LongDim pustroka As LongFor 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 IfNextEnd Sub
[/vba]
Помогите объединить эти два макроса в один, чтоб получилось так:
Мы на активной странице запускаем макрос (без выделения таблицы), он объединяет все одинаковые значения по столбцу B и после объедения, вставлялась строчка (после каждого объединившегося блока)
И еще, эти макросы работаю в обычной таблице. А как сделать чтоб пахали в умной таблице? Спасибо кто поможет.

Автор - baskakova7441
Дата добавления - 28.08.2021 в 10:18
Pelena Дата: Суббота, 28.08.2021, 20:55 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19517
Репутация: 4632 ±
Замечаний: ±

Excel 365 & Mac Excel
Файл с примером помог бы в понимании проблемы


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеФайл с примером помог бы в понимании проблемы

Автор - Pelena
Дата добавления - 28.08.2021 в 20:55
baskakova7441 Дата: Воскресенье, 29.08.2021, 07:11 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

Цитата Pelena, 28.08.2021 в 20:55, в сообщении № 2 ( писал(а)):
Файл с примером помог бы в понимании проблемы

Приложили файлик.
К сообщению приложен файл: bd_.xls (98.0 Kb)
 
Ответить
Сообщение
Цитата Pelena, 28.08.2021 в 20:55, в сообщении № 2 ( писал(а)):
Файл с примером помог бы в понимании проблемы

Приложили файлик.

Автор - baskakova7441
Дата добавления - 29.08.2021 в 07:11
Gustav Дата: Воскресенье, 29.08.2021, 17:43 | Сообщение № 4
Группа: Админы
Ранг: Участник клуба
Сообщений: 2843
Репутация: 1194 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
Цитата baskakova7441, 28.08.2021 в 10:18, в сообщении № 1 ( писал(а)):
как сделать чтоб объединение происходило только по определённым столбцам?
Самое простое - "проложить" циклы Select Case'м с указанием номеров столбцов срабатывания:

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



МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
Цитата baskakova7441, 28.08.2021 в 10:18, в сообщении № 1 ( писал(а)):
как сделать чтоб объединение происходило только по определённым столбцам?
Самое простое - "проложить" циклы 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 = ТrueEnd Sub
[/vba]

Автор - Gustav
Дата добавления - 29.08.2021 в 17:43
RAN Дата: Воскресенье, 29.08.2021, 18:00 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Цитата baskakova7441, 28.08.2021 в 10:18, в сообщении № 1 ( писал(а)):
А как сделать чтоб пахали в умной таблице?

Никак. Умная таблица на то и умная, чтобы не допускать извращений в виде объединенных ячеек.


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Цитата baskakova7441, 28.08.2021 в 10:18, в сообщении № 1 ( писал(а)):
А как сделать чтоб пахали в умной таблице?

Никак. Умная таблица на то и умная, чтобы не допускать извращений в виде объединенных ячеек.

Автор - RAN
Дата добавления - 29.08.2021 в 18:00
baskakova7441 Дата: Вторник, 31.08.2021, 16:28 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 20% ±

RAN, Gustav, Pelena, ребята, подскажите как в моем случае сделать так: чтоб при добавление данных через форму, они добавлялись с рамками и от центрованы
 
Ответить
СообщениеRAN, Gustav, Pelena, ребята, подскажите как в моем случае сделать так: чтоб при добавление данных через форму, они добавлялись с рамками и от центрованы

Автор - baskakova7441
Дата добавления - 31.08.2021 в 16:28
  • Страница 1 из 1
  • 1
Поиск:

Рейтинг@Mail.ru Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!