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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Объединение ячеек без потери данных
albertikhsanov00 Дата: Четверг, 03.11.2022, 07:38 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Здравствуйте, не могу решить одну задачу, нужно объединить ячейки без потери данных после нажатия условной кнопки, данные хранятся на столбцах D,E,F,G количество строк всегда меняется, поэтому желательно чтобы макрос заканчивал объединять на последней строке, также есть несколько объединённых ячеек, с которыми ничего не надо делать, но после них тоже идут данные в ячейках, которые тоже нужно объединять, для понимания прикрепил файл. Я нашел был макрос, но он объединяет только указанный диапазон. Заранее спасибо!!!
К сообщению приложен файл: 732723636.xlsm (20.0 Kb)
 
Ответить
СообщениеЗдравствуйте, не могу решить одну задачу, нужно объединить ячейки без потери данных после нажатия условной кнопки, данные хранятся на столбцах D,E,F,G количество строк всегда меняется, поэтому желательно чтобы макрос заканчивал объединять на последней строке, также есть несколько объединённых ячеек, с которыми ничего не надо делать, но после них тоже идут данные в ячейках, которые тоже нужно объединять, для понимания прикрепил файл. Я нашел был макрос, но он объединяет только указанный диапазон. Заранее спасибо!!!

Автор - albertikhsanov00
Дата добавления - 03.11.2022 в 07:38
albertikhsanov00 Дата: Четверг, 03.11.2022, 07:43 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

Забыл добавить, хотелось бы чтобы текст вмещался на определённую ширину ячейки, т.е. чтобы текст был написан на две и более строк.
 
Ответить
СообщениеЗабыл добавить, хотелось бы чтобы текст вмещался на определённую ширину ячейки, т.е. чтобы текст был написан на две и более строк.

Автор - albertikhsanov00
Дата добавления - 03.11.2022 в 07:43
msi2102 Дата: Четверг, 03.11.2022, 08:45 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 415
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Если правильно понял, то попробуйте так:
[vba]
Код
Sub ObedinitGorizontal()
lr = Cells(Rows.Count, 4).End(xlUp).Row
Range("$D$2:$G$" & lr).Select
Dim savetext As String
Application.DisplayAlerts = False
For k = 1 To Selection.Areas.Count
  For i = 1 To Selection.Areas(k).Rows.Count
    savetext = Selection.Areas(k).Cells(i, 1)
    For j = 2 To Selection.Areas(k).Columns.Count
      savetext = savetext & Chr(32) & Selection.Areas(k).Cells(i, j)
    Next
    Selection.Areas(k).Rows(i).Merge
    Selection.Areas(k).Cells(i, 1) = savetext
    Selection.Areas(k).Cells(i, 1).HorizontalAlignment = xlHAlignCenter
  Next
Next
Application.DisplayAlerts = True
End Sub
[/vba]
Цитата albertikhsanov00, 03.11.2022 в 07:43, в сообщении № 2 ()
чтобы текст был написан на две и более строк

А это Вам СЮДА или СЮДА
К сообщению приложен файл: 9714237.xlsm (19.1 Kb)


Сообщение отредактировал msi2102 - Четверг, 03.11.2022, 08:50
 
Ответить
СообщениеЕсли правильно понял, то попробуйте так:
[vba]
Код
Sub ObedinitGorizontal()
lr = Cells(Rows.Count, 4).End(xlUp).Row
Range("$D$2:$G$" & lr).Select
Dim savetext As String
Application.DisplayAlerts = False
For k = 1 To Selection.Areas.Count
  For i = 1 To Selection.Areas(k).Rows.Count
    savetext = Selection.Areas(k).Cells(i, 1)
    For j = 2 To Selection.Areas(k).Columns.Count
      savetext = savetext & Chr(32) & Selection.Areas(k).Cells(i, j)
    Next
    Selection.Areas(k).Rows(i).Merge
    Selection.Areas(k).Cells(i, 1) = savetext
    Selection.Areas(k).Cells(i, 1).HorizontalAlignment = xlHAlignCenter
  Next
Next
Application.DisplayAlerts = True
End Sub
[/vba]
Цитата albertikhsanov00, 03.11.2022 в 07:43, в сообщении № 2 ()
чтобы текст был написан на две и более строк

А это Вам СЮДА или СЮДА

Автор - msi2102
Дата добавления - 03.11.2022 в 08:45
albertikhsanov00 Дата: Четверг, 03.11.2022, 09:28 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

msi2102, не совсем так, нужно чтобы столбцы А, В, С не обьединялись, а только D, E , F, G
 
Ответить
Сообщениеmsi2102, не совсем так, нужно чтобы столбцы А, В, С не обьединялись, а только D, E , F, G

Автор - albertikhsanov00
Дата добавления - 03.11.2022 в 09:28
msi2102 Дата: Четверг, 03.11.2022, 10:03 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 415
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Ну тогда так
[vba]
Код
Sub ObedinitGorizontal_1()
lr = Cells(Rows.Count, 4).End(xlUp).Row
Dim savetext As String
Application.DisplayAlerts = False
For k = 2 To lr
    If Cells(k, 4).MergeCells = False Then
        savetext = Cells(k, 4) & Chr(32) & Cells(k, 5) & Chr(32) & Cells(k, 6) & Chr(32) & Cells(k, 7)
        Range(Cells(k, 4), Cells(k, 7)).Merge
        Cells(k, 4) = savetext
        Cells(k, 4).HorizontalAlignment = xlHAlignCenter
    End If
Next
Application.DisplayAlerts = True
End Sub
[/vba]
К сообщению приложен файл: 4657161.xlsm (22.5 Kb)
 
Ответить
СообщениеНу тогда так
[vba]
Код
Sub ObedinitGorizontal_1()
lr = Cells(Rows.Count, 4).End(xlUp).Row
Dim savetext As String
Application.DisplayAlerts = False
For k = 2 To lr
    If Cells(k, 4).MergeCells = False Then
        savetext = Cells(k, 4) & Chr(32) & Cells(k, 5) & Chr(32) & Cells(k, 6) & Chr(32) & Cells(k, 7)
        Range(Cells(k, 4), Cells(k, 7)).Merge
        Cells(k, 4) = savetext
        Cells(k, 4).HorizontalAlignment = xlHAlignCenter
    End If
Next
Application.DisplayAlerts = True
End Sub
[/vba]

Автор - msi2102
Дата добавления - 03.11.2022 в 10:03
albertikhsanov00 Дата: Четверг, 03.11.2022, 10:12 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 27
Репутация: 0 ±
Замечаний: 20% ±

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

Автор - albertikhsanov00
Дата добавления - 03.11.2022 в 10:12
  • Страница 1 из 1
  • 1
Поиск:

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