Значения ячеек вставить в одну ячейку через запятую

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Значения ячеек вставить в одну ячейку через запятую (Макросы/Sub)

timo64uk

Дата: Суббота, 05.10.2024, 11:55 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 100

Репутация: 1 ±

Замечаний: 0% ±

Office16

Добрый день.
Прошу вашего содействия.
На Листе БД ячейке С2 и иногда ниже по столбцу находятся ячейки содержащие данные. Нужно эти данные от ячейки С2 и до последней заполненной по столбцу С скопировать в одну ячейку E7 лист (Итог) через запятую и знак перехода на следующую строчку внутри одной ячейки (Alt+Enter).
Знаю что есть разделитель и по формуле.., прошу код VBA, если возможно.

К сообщению приложен файл: 888.xlsx (9.5 Kb)

Ответить

Hugo

Дата: Суббота, 05.10.2024, 12:59 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3693

Репутация: 790 ±

Замечаний: 0% ±

365

timo64uk, Можно рекордером в макрос записать ввод формулы

Код

=ОБЪЕДИНИТЬ(","&СИМВОЛ(10);;БД!C2:C6)

и далее ячейка.value=ячейка.value
P.S. да, сперва в макросе найти последнюю заполненную строку и поставить это значение в код вместо 6.
Если конечно есть в наличии функция ОБЪЕДИНИТЬ()...

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Сообщение отредактировал Hugo - Суббота, 05.10.2024, 13:05

Ответить

Nic70y

Дата: Суббота, 05.10.2024, 13:06 | Сообщение № 3

Группа: Друзья

Ранг: Экселист

Сообщений: 9008

Репутация: 2369 ±

Замечаний: 0% ±

Excel 2010

[vba]

Код

Sub u_700()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "c").End(xlUp).Row
    b = "," & Chr(10)
    e = ""
    For Each c In Range("c2:c" & a).SpecialCells(xlCellTypeConstants, 23)
        d = c.Row
        If d = a Then b = ""
        e = e & c.Value & b
    Next
    Sheets("Итог").Range("e7") = e
    Application.ScreenUpdating = True
End Sub

[/vba]

К сообщению приложен файл: 888.xlsm (18.1 Kb)

ЮMoney 41001841029809

Ответить

Hugo

Дата: Суббота, 05.10.2024, 13:20 | Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3693

Репутация: 790 ±

Замечаний: 0% ±

365

Ещё вариант по примеру:
[vba]

Код

Sub tt()
Dim a
a = Sheets("БД").[c2].CurrentRegion.Value
a = Application.Transpose(a)
[e7].Value = Join(a, "," & Chr(10))
End Sub

[/vba]
Оптимизируем:
[vba]

Код

Sub tt()
[e7].Value = Join(Application.Transpose(Sheets("БД").[c2].CurrentRegion.Value), "," & Chr(10))
End Sub

[/vba]

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Сообщение отредактировал Hugo - Суббота, 05.10.2024, 13:27

Ответить

timo64uk

Дата: Суббота, 05.10.2024, 15:24 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 100

Репутация: 1 ±

Замечаний: 0% ±

Office16

Спасибо огромное.
Спасли меня от долгих поисков и перебора всех операторов).

Ответить

timo64uk

Дата: Четверг, 10.10.2024, 11:37 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 100

Репутация: 1 ±

Замечаний: 0% ±

Office16

Цитата Nic70y, 05.10.2024 в 13:06, в сообщении № 3 (

)

c2:c

Прошу помощи в изменении кода.
[vba]

Код

Dim a As Variant
Dim b As Variant
Dim e As Variant
Dim c As Variant
Dim d As Variant
    a = Cells(Rows.Count, "c").End(xlUp).Row
    b = "," & Chr(10)
    e = ""
    For Each c In Range("c2:c" & a).SpecialCells(xlCellTypeConstants, 23)
        d = c.Row
        If d = a Then b = ""
        e = e & c.Value & b
    Next
    Sheets("Итог").Range("e7") = e

[/vba]
Т.к. в случае если в столбце С ниже С2 отсутствуют данные, т.е. данные только в С2 и при этом другие произвольные ячейки листа не пусты, то макрос подтягивает и эти значения (см. лист Итог в приложенном файле).
Буду рад любой помощи... Сам-то никак "не дойду". :'(