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

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Объединение ячеек на VBA - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение ячеек на VBA (Макросы/Sub)
Объединение ячеек на VBA
rahimbulekov2001 Дата: Пятница, 19.08.2022, 11:26 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 20% ±

Привет друзья

помогите со скриптом VBA

Мне нужно Объединить ячейки

Подробнее в файле

Спасибо!
К сообщению приложен файл: _Microsoft_Word.docx(174.1 Kb) · ____..xlsx(10.6 Kb)


Сообщение отредактировал rahimbulekov2001 - Пятница, 19.08.2022, 14:48
 
Ответить
СообщениеПривет друзья

помогите со скриптом VBA

Мне нужно Объединить ячейки

Подробнее в файле

Спасибо!

Автор - rahimbulekov2001
Дата добавления - 19.08.2022 в 11:26
китин Дата: Пятница, 19.08.2022, 14:25 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 6895
Репутация: 1056 ±
Замечаний: 0% ±

Excel 2007;2010;2016
rahimbulekov2001, Поменяйте название темы на более вменяемое
[moder]исправлено[/moder]


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
Сообщениеrahimbulekov2001, Поменяйте название темы на более вменяемое
[moder]исправлено[/moder]

Автор - китин
Дата добавления - 19.08.2022 в 14:25
mgt Дата: Понедельник, 22.08.2022, 14:14 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 35
Репутация: 4 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim i%, k%
Dim s$
Dim r As Range
i = 7 'номер строки первого сотрудника
s = Range("b" & i).Value
Range("b" & i).Offset(1, 0).Select
Do While ActiveCell.Value <> ""
    If ActiveCell.Value = s Then
        Set r = ActiveCell
        Range(r, r.Offset(-1, 0)).MergeCells = True
        Range(r.Offset(0, 1), r.Offset(-1, 1)).MergeCells = True
        Range(r.Offset(0, 2), r.Offset(-1, 2)).MergeCells = True
        Range(r.Offset(0, -1), r.Offset(-1, -1)).MergeCells = True
    End If
    s = ActiveCell.Value
    ActiveCell.Offset(1, 0).Select
Loop
With Range("b" & i & ":d" & ActiveCell.Row)
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
End With
With Range("a" & i & ":a" & ActiveCell.Row)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
End With
Range("b" & i - 1).Offset(1, 0).Select
k = 1
Do While ActiveCell.Value <> ""
    ActiveCell.Offset(0, -1).Value = k
    ActiveCell.Offset(1, 0).Select
    k = k + 1
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
[/vba]
 
Ответить
Сообщение[vba]
Код
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim i%, k%
Dim s$
Dim r As Range
i = 7 'номер строки первого сотрудника
s = Range("b" & i).Value
Range("b" & i).Offset(1, 0).Select
Do While ActiveCell.Value <> ""
    If ActiveCell.Value = s Then
        Set r = ActiveCell
        Range(r, r.Offset(-1, 0)).MergeCells = True
        Range(r.Offset(0, 1), r.Offset(-1, 1)).MergeCells = True
        Range(r.Offset(0, 2), r.Offset(-1, 2)).MergeCells = True
        Range(r.Offset(0, -1), r.Offset(-1, -1)).MergeCells = True
    End If
    s = ActiveCell.Value
    ActiveCell.Offset(1, 0).Select
Loop
With Range("b" & i & ":d" & ActiveCell.Row)
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
End With
With Range("a" & i & ":a" & ActiveCell.Row)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
End With
Range("b" & i - 1).Offset(1, 0).Select
k = 1
Do While ActiveCell.Value <> ""
    ActiveCell.Offset(0, -1).Value = k
    ActiveCell.Offset(1, 0).Select
    k = k + 1
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
[/vba]

Автор - mgt
Дата добавления - 22.08.2022 в 14:14
rahimbulekov2001 Дата: Вторник, 23.08.2022, 07:19 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 20% ±

mgt, Спасибо большое, все идеально работает!
 
Ответить
Сообщениеmgt, Спасибо большое, все идеально работает!

Автор - rahimbulekov2001
Дата добавления - 23.08.2022 в 07:19
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение ячеек на VBA (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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