Склеивание текста по условию

Про то, как можно быстро склеивать текст из нескольких ячеек в одну и, наоборот, разбирать длинную текстовую строку на составляющие я уже писал. Теперь же давайте рассмотрим близкую, но чуть более сложную задачу - как склеивать текст из нескольких ячеек при выполнении определенного заданного условия. 

Допустим, что у нас имеется база данных по клиентам, где одному названию компании может соответствовать несколько разных email'ов ее сотрудников. Наша задача состоит в том, чтобы собрать все адреса по названиям компаний и сцепить их (через запятую или точку с запятой), чтобы сделать потом, например, почтовую рассылку по клиентам, т.е. получить на выходе что-то похожее на:

склеивание (сцепка) текста по условию

Другими словами, нам нужен инструмент, который будет склеивать (сцеплять) текст по условию - аналог функции СУММЕСЛИ (SUMIF), но для текста.

Способ 0. Формулой

Не очень изящный, зато самый простой способ. Можно написать несложную формулу, которая будет проверять отличается ли компания в очередной строке от предыдущей.  Если не отличается, то приклеиваем через запятую очередной адрес. Если отличается, то "сбрасываем" накопленное, начиная заново:

Сцепка текста по условию формулой

Минусы такого подхода очевидны: из всех ячеек полученного дополнительного столбца нам нужны только последние по каждой компании (желтые). Если список большой, то чтобы их быстро отобрать придется добавить еще один столбец, использующий функцию ДЛСТР (LEN), проверяющий длину накопленных строк:

Отбор строк

Теперь можно отфильтровать единички и скопировать нужные склейки адресов для дальнейшего использования.

Способ 1. Макрофункция склейки по одному условию

Если исходный список не отсортирован по компаниям, то приведенная выше простая формула не работает, но можно легко выкрутиться с помощью небольшой пользовательской функции на VBA. Откройте редактор Visual Basic нажатием на сочетание клавиш Alt+F11 или с помощью кнопки Visual Basic на вкладке Разработчик (Developer). В открывшемся окне вставьте новый пустой модуль через меню Insert - Module и скопируйте туда текст нашей функции:

Function MergeIf(TextRange As Range, SearchRange As Range, Condition As String)
    Dim Delimeter As String, i As Long
    Delimeter = ", " 'символы-разделители (можно заменить на пробел или ; и т.д.)
    
    'если диапазоны проверки и склеивания не равны друг другу - выходим с ошибкой
    If SearchRange.Count <> TextRange.Count Then
        MergeIf = CVErr(xlErrRef)
        Exit Function
    End If
    
    'проходим по все ячейкам, проверяем условие и собираем текст в переменную OutText
    For i = 1 To SearchRange.Cells.Count
        If SearchRange.Cells(i) Like Condition Then OutText = OutText & TextRange.Cells(i) & Delimeter
    Next i
    
    'выводим результаты без последнего разделителя
    MergeIf = Left(OutText, Len(OutText) - Len(Delimeter))
End Function

Если теперь вернуться в Microsoft Excel, то в списке функций (кнопка fx в строке формул или вкладка Формулы - Вставить функцию) можно будет найти нашу функцию MergeIf в категории Определенные пользователем (User Defined). Аргументы у функции следующие:

функция сцепить если выполняется условие

Способ 2. Сцепить текст по неточному условию

Если заменить в 13-й строчке нашего макроса первый знак = на оператор приблизительного совпадения Like, то можно будет осуществлять склейку по неточному совпадению исходных данных с критерием отбора. Например, если название компании может быть записано в разных вариантах, то мы можем одной функцией проверить и собрать их все:

склейка по приблизительному условию

Поддерживаются стандартные спецсимволы подстановки:

  • звездочка (*) - обозначает любое количество любых символов (в т.ч. и их отсутствие)
  • вопросительный знак (?) - обозначает один любой символ
  • решетка (#) - обозначает одну любую цифру (0-9)

По умолчанию оператор Like регистрочувствительный, т.е. понимает, например, "Орион" и "оРиОн" как разные компании. Чтобы не учитывать регистр можно добавить в самое начало модуля в редакторе Visual Basic строчку Option Compare Text, которая переключит Like в режим, когда он невосприимчив к регистру.

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

  • ?1##??777RUS - выборка по всем автомобильным номерам 777 региона, начинающимся с 1
  • ООО* - все компании, название которых начинается на ООО
  • ##7## - все товары с пятизначным цифровым кодом, где третья цифра 7
  • ????? - все названия из пяти букв и т.д.

Способ 3. Макрофункция склейки текста по двум условиям

В работе может встретиться задача, когда сцеплять текст нужно больше, чем по одному условию. Например представим, что в нашей предыдущей таблице добавился еще один столбец с городом и склеивание нужно проводить не только для заданной компании, но еще и для заданного города. В этом случае нашу функцию придется немного модернизировать, добавив к ней проверку еще одного диапазона:

Function MergeIfs(TextRange As Range, SearchRange1 As Range, Condition1 As String, SearchRange2 As Range, Condition2 As String)
    Dim Delimeter As String, i As Long
    Delimeter = ", " 'символы-разделители (можно заменить на пробел или ; и т.д.)
    
    'если диапазоны проверки и склеивания не равны друг другу - выходим с ошибкой
    If SearchRange1.Count <> TextRange.Count Or SearchRange2.Count <> TextRange.Count Then
        MergeIfs = CVErr(xlErrRef)
        Exit Function
    End If
    
    'проходим по все ячейкам, проверяем все условия и собираем текст в переменную OutText
    For i = 1 To SearchRange1.Cells.Count
        If SearchRange1.Cells(i) = Condition1 And SearchRange2.Cells(i) = Condition2 Then
            OutText = OutText & TextRange.Cells(i) & Delimeter
        End If
    Next i
    
    'выводим результаты без последнего разделителя
    MergeIfs = Left(OutText, Len(OutText) - Len(Delimeter))
End Function

Применяться она будет совершенно аналогично - только аргументов теперь нужно указывать больше:

склейка по нескольким условиям

Способ 4. Группировка и склейка в Power Query

Решить проблему можно и без программирования на VBA, если использовать бесплатную надстройку Power Query. Для Excel 2010-2013 ее можно скачать здесь, а в Excel 2016 она уже встроена по умолчанию. Последовательность действий будет следующей:

Power Query не умеет работать с обычными таблицами, поэтому первым шагом превратим нашу таблицу в "умную". Для этого ее нужно выделить и нажать сочетание Ctrl+T или выбрать на вкладке Главная - Форматировать как таблицу (Home - Format as Table). На появившейся затем вкладке Конструктор (Design) можно задать имя таблицы (я оставил стандартное Таблица1):

Умная таблица

Теперь загрузим нашу таблицу в надстройку Power Query. Для этого на вкладке Данные (если у вас Excel 2016) или на вкладке Power Query (если у вас Excel 2010-2013) жмем Из таблицы (Data - From Table):

Загрузка в Power Query

В открывшемся окне редактора запросов выделяем щелчком по заголовку столбец Компания и сверху жмем кнопку Группировать (Group By). Вводим имя нового столбца и тип операции в группировке - Все строки (All Rows):

Группировка в Power Query

Жмем ОК и получаем для каждой компании мини-таблицу сгруппированных значений. Содержимое таблиц хорошо видно, если щелкать левой кнопкой мыши в белый фон ячеек (не в текст!) в получившемся столбце:

Содержимое таблиц группировки

Теперь добавим еще один столбец, где с помощью функции склеим через запятую содержимое столбцов Адрес в каждой из мини-таблиц. Для этого на вкладке Добавить столбец жмем Пользовательский столбец (Add column - Custom column) и в появившемся окне вводим имя нового столбца и формулу сцепки на встроенном в Power Query языке М:

Пользовательский столбец с функцией склейки

Обратите внимание, что все М-функции регистрочувствительные (в отличие от Excel). После нажатия на ОК получаем новый столбец со склееными адресами:

Результат

Осталось удалить ненужный уже столбец ТаблАдресов (правой кнопкой мыши по заголовку - Удалить столбец) и выгрузить результаты на лист, нажав на вкладке Главная - Закрыть и загрузить (Home - Close and load):

Выгрузка результатов на лист

Важный нюанс: в отличие от предыдущих способов (функций), таблицы из Power Query не обновляются автоматически. Если в будущем произойдут какие-либо изменения в исходных данных, то нужно будет щелкнуть правой кнопкой в любое место таблицы результатов и выбрать команду Обновить (Refresh).

Ссылки по теме


MCH
03.08.2014 09:42:19
В качестве предложения, Delimeter лучше передавать в функцию опционально, будет более универсально, по умолчанию задать запятую с пробелом, но и пользователь сам может задать любое альтернативное значение.

Не понятно, зачем MergeIf = CVErr(xlErrRef)?
Функция MergeIf определена как строковая, она не может вернуть значение ошибки #ССЫЛКА!, результатом данной строки будет ошибка #ЗНАЧ!, т.к. присваивается недопустимое значение строковой переменной и до строки Exit Function дело даже не доходит.
Если тип функции был Variant, тогда другое дело.

И еще, Николай, почему Вы не объявляете все переменные, в данном примере не объявлена переменная OutText, что не дает возможности использовать Option Explicit
Объявление не всех переменных наблюдается и в PLEX.
03.08.2014 10:35:46
Традиционно спасибо, МСН :) Про Variant и объявление переменных - согласен, поправил. Delimeter можно и опциональным аргументом передавать, конечно, дело вкуса.
22.08.2014 14:21:10
Спасибочки!!!:)
16.10.2014 16:46:54
Николай, огромное спасибо за макрос, действенно.
Единственный вопрос: а как заставить формулу сцепить только уникальные значения?
Например, у меня есть сводная таблица:
Фирма1Город1 Продавец1
Фирма1Город1 Продавец2
Фирма1Город1 Продавец3
Фирма1Город2 Продавец4
Фирма1Город2 Продавец3
Фирма1Город2 Продавец2
Фирма1Город3 Продавец1
Фирма1Город3 Продавец4
Фирма2 ...
Фирма3 ...
...

Я по маске хочу вытащить всех продавцов для Фирмы1 во всех городах (пишу *фирма1*) и оно мне выдает не 4 уникальных продавца, а все 8 записей, (предсказуемо) задваивая некоторых продавцов.
Мне кажется, как-то можно дописать условие проверки на повторы, но мои познания в VBA не столь глубоки :(

Заранее спасибо!
23.11.2014 09:38:36
А если сначала просто удалить дубликаты?
25.11.2014 17:11:52
Там была сложная таблица с кучей переменных, так не работает)
Решилось (немного коряво) формированием пайвота и перетягиванием его каждый раз так так, чтобы для каждой отдельной переменной были уникальные сочетания..
12.02.2016 18:57:18
Есть ряд столбцов, суммирующихся по определённому признаку. Для этих сумм надо написать описание в тексте, собственно Ваш макрос очень помог.
Но ряд значений действительно повторяются, существует ли какая-то альтернатива?
22.10.2014 15:32:07
Добрый день Николай!
сделал как все написано, но выдает ошибку #ЗНАЧ -связано ли это с тем что в первом столбце не текст а номера (числовые значения)? Вроде все столбцы перевел в "текстовый" формат -все равно не получается запустить.
Заранее спасибо!
23.11.2014 09:39:59
Сергей, попробуйте заменить в 13 строке первого макроса оператор Like на знак =
19.11.2014 15:18:19
А как сцепить только не пустые ячейки, но также по условию?
23.11.2014 09:36:10
Добавить в 13-ю строчку макроса проверку на пустоту в ячейке:
Function MergeIf(TextRange As Range, SearchRange As Range, Condition As String)
    Dim Delimeter As String, i As Long
    Delimeter = ", " 'символы-разделители (можно заменить на пробел или ; и т.д.)
     
    'если диапазоны проверки и склеивания не равны друг другу - выходим с ошибкой
    If SearchRange.Count <> TextRange.Count Then
        MergeIf = CVErr(xlErrRef)
        Exit Function
    End If
     
    'проходим по все ячейкам, проверяем условие и собираем текст в переменную OutText
    For i = 1 To SearchRange.Cells.Count
        If SearchRange.Cells(i) Like Condition And Len(TextRange.Cells(i))>0 Then OutText = OutText & TextRange.Cells(i) & Delimeter
    Next i
     
    'выводим результаты без последнего разделителя
    MergeIf = Left(OutText, Len(OutText) - Len(Delimeter))
End Function
24.11.2014 11:50:42
Спасибо большое! :)
04.05.2023 01:52:41
Добрый день!
А какую надо строчку добавить в макрос по нескольким условиям, чтобы пропускало пустые вместо отображения #ЗНАЧ!
16.02.2015 17:02:41
Добрый день! Николай, все сделал так как Вы написали, но почему то 2 формулы работают, остальные 2 пишут ЗНАЧ. Причем эти формулы находятся на одном листе и чередуются ( т.е. первая работает, вторая не работает). В чем может быть причина?
16.02.2015 18:50:55
Извиняюсь Николай)) нашел ошибку и устранил.
16.02.2015 19:12:57
Ничего страшного, бывает :)
17.02.2015 16:57:13
Привет всем! Николай, подскажите пожалуйста что делать? Вопрос такой: с помощью данного макроса я делаю некий отчет(за каждый месяц имеются определенные статьи газет, и по выбору месяца я хотел бы видеть все статьи за заданный период), т.е. условиями являются месяцы, и когда я меняю, условно говоря январь на февраль, у меня в формулах пишет #ИМЯ?
24.02.2015 11:40:54
Николай, спасибо за макрос )) Скажите, пожалуйста, как сделать, чтобы вместо запятой текст начинался все время с новой строки.
24.02.2015 19:50:17
Просто замените в третьей строке символ разделителя (запятую) на символ переноса строки (его код 10), т.е.
 Delimeter = Chr(10)
25.02.2015 10:52:00
Я уже так пробовала, в результате все в одной строке без пробелов. Сегодня еще раз попробовала в новом файле, скопировала код и поменяла 3 строку - тоже самое :oops:  А потом когда я уже сдалась почти, оказалось что нужно просто нажать кнопку перенос текста  :D
25.02.2015 10:55:25
В общем самой за себя стыдно :D
25.02.2015 11:28:24
:D Все ОК - бывает
26.02.2015 13:49:23
Здравствуйте! Помогите, пожалуйста с решением. Задача: в отдельной ячейке склеить весь текст, который высвечивается в последнем столбце.

Есть таблица:
№ офисаКол-во заявокИз них состоялосьПланНе заказали
152не выполнен
200не заказали№2
333выполнен
400не заказали№4
500
не заказали
№5
Я склеивала текст из нескольких ячеек в одну, но проблема в том, что пустая строка (как, например, между №№ 2 и 4) в склеенном тексте выдает лишние пробелы. Мне же нужно их исключить. Либо автоматически выбирать и склеивать только те ячейки, в которых содержится текст.

Как это сделать?
26.02.2015 23:02:27
Замените на этот блок, блок из оригинала.
'проходим по всем ячейкам, проверяем условие и собираем текст в переменную OutText
For i = 1 To SearchRange.Cells.Count
    If TextRange.Cells(i) <> "" Then
        If SearchRange.Cells(i) Like Condition Then OutText = OutText & TextRange.Cells(i) & Delimeter
    End If
Next i
26.02.2015 21:49:35
На форуме тоже есть тема Универсальная функция Сцепить. Чем примечательна, у неё больше настроек (много различных условий, сортировка, вывод уникальных), но смысл тот же. Может кому пригодится.
21.04.2015 09:34:37
Добрый день!

пожалуйста, помогите с решением такой задачи: склеить текст в ячейках до ячейки содержащей "MF". По сути, необходимо чтобы текст, стоящий в ячейках До ячейки с MF отображался как единое целое, а ячейка с MF стояла отдельно.

Спасибо!
25.05.2015 13:48:03
Николай, добрый день!

Спасибо за ваши примеры!
Рассматриваю ваш вариант №1. Работает отлично, но если необходимо проработать объемную базу, то для каждого значения необходимо в ручную указывать условие. Это не совсем удобно.
Если же использовать эту формулу для первого значения, а затем распространить на все значения, то получается такая картина как у меня на скрине. Тоесть формула прописывает возле каждого дубля количество электронных адресов минус один эл адрес..
Возможно ли в формуле использовать какое то решение VBA по поиску дублей? При этом если распространить данную формулу по всему массиву, то электронные адреса бы склеивались у одного из дублей, но у последующих значений, которые дублируются сцепка не производилась бы.
07.07.2015 14:08:14
Сергей, в формуле используйте динамические и статические ссылки.
Динамические не меняются, если "растянуть" формулу.
Т.е. в Вашем случае в ячейке D2 пишем =MergeIf($B$2:$B$9;$A$2:$A$9;C2).
Потом растянуть формулу на весь столбец и будет меняться только последнее значение C2, C3 и т.д
07.07.2015 14:10:09
А для того чтобы не было дублей, скопируйте название компании на новый лист, уберите дубли (Данные - убрать дубликаты) и будет Вам счастье
06.08.2015 18:56:38
мне это больше подошло (источник http://excelfin.ru/index.php/opinion/77-root)
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' efSumText() - объединение строк по условию
' rngFind - диапазон поиска
' sFind - условие с применением символов маски "?" и "*"
' rngValues - диапазон объединения
' sDelimiter - разделитель
'
' Использование:
' =efSumText(a1:a100) - сцепка строк с использование запятой в качестве разделителя
' =efSumText(a1:a100; "а*";) - сцепка строк, начинающихся на букву "а"
' =efSumText(b1:b100; "с*о"; a1:a100) - сцепка строк из первого столбца с проверкой на условие (начинается на "с", заканчивается на "о" второго столбца
' =efSumText(c1:c100; ">100"; a1:a100) - сцепка строк из первого столбца с проверкой третьего столбца на число (>100)
' =efSumText(c1:c100; ">100"; a1:a100, "+";) - то же, но с разделителем "+"
'
' © 2011, www.excelfin.ru
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function efSumText(rngFind As Range, _
Optional sFind As String = "", _
Optional rngValues As Range = Nothing, _
Optional sDelimiter As String = ", ";) As String
Dim sResult As String
Dim nIdx As Long
Dim bFlag As Boolean
 
For nIdx = 1 To rngFind.Cells.Count
If Not IsError(rngFind.Cells(nIdx).Value) Then
bFlag = False
If (sFind = "";) Then
bFlag = True
ElseIf IsNumeric(rngFind.Cells(nIdx).Value) Then
On Error Resume Next
bFlag = Application.Evaluate(CStr(Val(rngFind.Cells(nIdx).Value)) & sFind)
On Error GoTo 0
Else
bFlag = (rngFind.Cells(nIdx).Value Like sFind)
End If
 
If bFlag Then
If (sResult <> "";) Then
sResult = sResult & sDelimiter
End If
 
If (rngValues Is Nothing) Then
sResult = sResult & CStr(rngFind.Cells(nIdx).Value)
Else
sResult = sResult & CStr(rngValues.Cells(nIdx).Value)
End If
End If
End If
Next
efSumText = sResult
End Function
07.08.2015 10:01:01
А также от одного из великих (душой и мастерством VBA) людей на этом (и на своём)  сайте. The_Prist.
Версия лучше тем, что есть возможность сцеплять значения без их повторения (уникальные). Браво! 8)
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : СцепитьЕсли
' DateTime  : 10.09.2010 13:42
' Author    : The_Prist(Дмитрий); WebMoney - R298726502453; Яндекс.Деньги - 41001332272872;
'             http://www.excel-vba.ru
' Purpose   : http://www.excel-vba.ru/index.php?file=Tips_Macro_CoupleIF
'---------------------------------------------------------------------------------------
Function СцепитьЕсли(ByRef Диапазон As Range, ByVal Критерий As String, ByRef Диапазон_сцепления As Range, Optional Разделитель As String = " ", Optional БезПовторов As Boolean = False) As String
    Dim li As Long, sStr As String, avItem, avDateArr(), avRezArr(), lUBnd As Long
    If Диапазон.Count > 1 Then
        avDateArr = Intersect(Диапазон, Диапазон.Parent.UsedRange).Value
        avRezArr = Intersect(Диапазон_сцепления, Диапазон_сцепления.Parent.UsedRange).Value
        If Диапазон.Rows.Count = 1 Then
            avDateArr = Application.Transpose(avDateArr)
            avRezArr = Application.Transpose(avRezArr)
        End If
    Else
        ReDim avDateArr(1, 1): ReDim avRezArr(1, 1)
        avDateArr(1, 1) = Диапазон.Value
        avRezArr(1, 1) = Диапазон_сцепления.Value
    End If
    lUBnd = UBound(avDateArr, 1)
    'Опрееделяем вхождение операторов сравнения в Критерий
    Dim objRegExp As Object, objMatches As Object
    Set objRegExp = CreateObject("VBScript.RegExp";)
    objRegExp.Global = False: objRegExp.Pattern = "=|<>|=>|>=|<=|=<|>|<"
    Set objMatches = objRegExp.Execute(Критерий)
    'Если есть вхождения
    If objMatches.Count > 0 Then
        Dim sStrMatch As String
        sStrMatch = objMatches.Item(0)
        Критерий = Replace(Replace(Критерий, sStrMatch, "", 1, 1), Chr(34), "", 1, 2)
        Select Case sStrMatch
        Case "="
            For li = 1 To lUBnd
                If avDateArr(li, 1) = Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "";) & avRezArr(li, 1)
                End If
            Next li
        Case "<>"
            For li = 1 To lUBnd
                If avDateArr(li, 1) <> Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "";) & avRezArr(li, 1)
                End If
            Next li
        Case ">=", "=>"
            For li = 1 To lUBnd
                If avDateArr(li, 1) >= Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "";) & avRezArr(li, 1)
                End If
            Next li
        Case "<=", "=<"
            For li = 1 To lUBnd
                If avDateArr(li, 1) <= Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "";) & avRezArr(li, 1)
                End If
            Next li
        Case ">"
            For li = 1 To lUBnd
                If avDateArr(li, 1) > Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "";) & avRezArr(li, 1)
                End If
            Next li
        Case "<"
            For li = 1 To lUBnd
                If avDateArr(li, 1) < Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "";) & avRezArr(li, 1)
                End If
            Next li
        End Select
    Else    'Если нет вхождения
        For li = 1 To lUBnd
            If avDateArr(li, 1) Like Критерий Then
                If Trim(avRezArr(li, 1)) <> "" Then _
                   sStr = sStr & IIf(sStr <> "", Разделитель, "";) & avRezArr(li, 1)
            End If
        Next li
    End If
    
    If БезПовторов Then
        Dim oDict As Object, sTmpStr
        Set oDict = CreateObject("Scripting.Dictionary";)
        sTmpStr = Split(sStr, Разделитель)
        On Error Resume Next
        For li = LBound(sTmpStr) To UBound(sTmpStr)
            oDict.Add sTmpStr(li), sTmpStr(li)
        Next li
        sStr = ""
        sTmpStr = oDict.keys
        For li = LBound(sTmpStr) To UBound(sTmpStr)
            sStr = sStr & IIf(sStr <> "", Разделитель, "";) & sTmpStr(li)
        Next li
    End If
    СцепитьЕсли = sStr
End Function
12.08.2015 12:37:13
Добрый день.
подскажите пожалуйста, как следует изменить макрос, чтобы он вписывал в ячейку данные таким образом:

1    2    3     4     5
1   а   б   в      д     а,e;б,ё;в,ж
2   е   ё   ж             з;и;й
3   з   и    й     к      л;м;н
4   л  м    н      о
т.е грубо говоря, поочерёдно вписывала все значения ячеек данного столбца через запятую, после данные из следующих столбцов (между столбцами разделитель точка с запятой) до тех пор пока не будет выведено не пустое значение в контрольном столбце, а после проделала бы то же самое на следующей строчке. гарантируется, что первое и последнее значение контрольного столбца не пустые, но значения столбцов из которых нужно брать данные могут оказаться пустыми, в этом случае не нужно выводить несколько разделителей. да, и ещё, желательно, чтобы перед значениями указывалось бы название столбца (т.е в моей таблице -это значение первой ячейки), тогда первая строка исходных значений в приведённой мной таблице для примера будет иметь вид: название ячейки 1:а,е;название ячейки 2:б,ё;название ячейки 3:в,ж   (между названиями столбцов и данными ячеек пусть будет разделитель двоеточие, а в случае пустых значений (во всех ячейках) -не указывалось бы название вообще). Заранее спасибо за ответ.
13.08.2015 16:45:33
Павел, добрый день.
Ваше решение особенно по не точным условиям считаю лучшим  ,как по простоте реализации так и по функциональности. Большое спасибо.
Пытаюсь адаптировать под мою задачу.

Подскажите, пожалуйста,

как в качестве разделителя использовать:
вначале нумерацию, затем значение подобранное по условию, затем точку с запятой,
при этом что бы начать с нвой строки я так понял втавить (Delimeter = Chr(10)).

С уважением, Алексей.
09.09.2015 17:18:55
Здравствуйте,примеров много видела,но так как опыта нет,обращаюсь к Вам, с просьбой.
у меня есть 2 поля(INTEGER)

INN                              PhoneNumber
344565667678         80976338834

Мне нужно склеить так:
(344565667678,  80976338834)

желательно макрос, можно и функцию.
Заранее благодарна
27.10.2016 13:56:05
Добрый день. у меня имеется реестр названий нарушений с датами, (2 столбца. нарушение - дата)
Требуется сцепить даты с одного периода до другого периода включительно. как это реализовать?
По данной формуле оно вытягивает вообще все даты которые есть в реестре.
31.10.2016 19:24:14
я б предложил простой спсоб:добавить столкиб с условием (функция если) которая бы реагировала на условие в заданных ячейках. если истина то к примеру в столбике появляется "да", или пусто. далее с помощью функции выше указал бы условие сцепить ячейки с текстом "да"
01.11.2016 09:01:22
Я короче применил эту формулу к сводной таблице в который только выбранный период и получил то что хотел.
06.05.2017 14:09:51
Добрый день уважаемый Николай, первый пример меня очень выручил огромное вам спасибо за такие доступные уроки. Единственный вопрос согласно варианта 2 при замене знака = на оператор Like в 13 строчке макрос выдаёт ошибку, с чем это связано. Заранее большое спасибо.
03.12.2017 18:58:00
подскажите пожалуйста, как следует изменить макрос, чтобы он вписывал в ячейку данные таким образом:

т.е не через запятой  или точка-запятой, а именно чтобы находились друг под другом
04.12.2017 09:14:10
В третьей строке макроса задать разделитель - перенос строки, т.е. написать:
Delimiter = vbNewLine
19.12.2017 06:47:50
здравствуете! А как  в Power Query сделат разделитель - перенос строки.
Ошибка выходит если я  пишу просто NewLine
Text.Combine([дата][Организация],NewLine)
04.12.2017 16:55:40
Спасибо большое! А что нужно сделать чтобы кавычки исчезли
04.12.2017 17:31:06
и ещё одни вопрос
я пишу дату С использованием дроби,например, 01/12/2017 а excel автоматически меняет формат и ставить точку вместо дроби что нужно делать чтобы это не произошло
05.12.2017 18:04:10
Спасибо!!! я уже решил свою проблему,ещё раз огромное спасибо вам!
24.02.2018 11:03:26
Только зачем всё так сложно, если с объединением по условию спокойно справляется формула в массиве.

{=ПОДСТАВИТЬ(ПОДСТАВИТЬ(ОБЪЕДИНИТЬ(", ";1;ЕСЛИ(Таблица1[@[barren]:[temperate]]="x";Таблица1[[#Заголовки];[barren]:[temperate]];));"0, ";"");", 0";"")}
 
Фигурные скобки - это формула массива (знающие Excel понимают) - выставляются автоматом после нажатия комбинации "Ctrl+Shift+Enter", самим их писать не надо - не сработает.
Расшифровка
1. У меня таблица оформлена как элемент таблица, поэтому, вы не увидите стандартных адресов;
2. Конструкции "Подставить()" фильтрует образовавшиеся нули там, где объединения было пустое, почему то параметр "1" в формуле "объединить" в массиве не сработал
3. Адреса в формуле "объединить()" заданы областями - без наложения массива по "Ctrl+Shift+Enter" конструкция работать не будет и вы получите ошибку.
4. Формула работает так: если в строке в ячейке есть "х", то берётся значение из шапки и так с перебором всех столбцов, после чего включается фильтр "Подставить" и выпалывает значения "0, " и ", 0".

И не надо надстроек и макросов. Только наложить чары в виде массива "Ctrl+Shift+Enter".
19.07.2018 13:35:17
Здравствуйте. Большое спасибо за макрос. Давно ищу такой "инструмент" для работы. Однако возникает вопрос, как быть, если необходимо склеить текст из нескольких столбцов?
P.S А как изменить имя функции?
26.09.2018 17:04:13
не знаю почему мое прошлое сообщение не прошло модерацию, спасибо большое за этот макрос! у меня вопрос, как он будет выглядеть для склеивания данных по 3 условиям? Очень нужна такая формула, буду очень благодарна за нее!
01.10.2018 10:47:11
Здравствуйте! Что и куда добавить в макрос чтобы перед каждым сцепленным значением (в данном случае "адрес") добавляло переменную списка, например чтобы получилось: 1) адрес1; 2) адрес2; 3) адрес3... и т.д.
05.02.2019 09:34:32
Добрый день! Николай, есть ли функция, которая склеит несколько ячеек в одной ячейке, чтобы каждый текст был на отдельной строке в ячейке и имел порядковый номер?
09.03.2019 13:23:14
Зачем писать макрос ,если работает формула массива?

{=ПОДСТАВИТЬ(ПОДСТАВИТЬ(ОБЪЕДИНИТЬ(", ";1;ЕСЛИ(($C$3:$C$59)=$R3;E$3:E$59;""));"0, ";"");", 0";"")}
 
нет времени адаптировать под ваш случай, но тут и так всё понятно. ПОДСТАВИТЬ() - фильтрует текст от мусора.
29.05.2019 15:12:49
Доброго времени суток!
Николай добавил в Вашу функцию параметр "Сумма" теперь если ввести в конце "1" она будет складывать как "СуммаЕсли", а если "2" то перемножит все найденные значения, исправления конечно бесполезные, но прикольно. И ещё написал на русском название параметров функции, просто мне кажется так удобнее

Option Compare Text

Function СКЛ_ЯЧ_1(Текст As Range, Диапазон As Range, Ключ As String, Сумма As Byte)
    Dim Delimeter As String, i As Long
    Delimeter = ", " 'символы-разделители (можно заменить на пробел или ; и т.д.)
     
    'если диапазоны проверки и склеивания не равны друг другу - выходим с ошибкой
    If Диапазон.Count <> Текст.Count Then
        СКЛ_ЯЧ_1 = CVErr(xlErrRef)
        Exit Function
    End If
     k = 0
    'проходим по все ячейкам, проверяем условие и собираем текст в переменную OutText
    For i = 1 To Диапазон.Cells.Count
        If Диапазон.Cells(i) Like Ключ And Len(Текст.Cells(i)) > 0 Then
            If Сумма = 0 Then
                OutText = OutText & Текст.Cells(i) & Delimeter
            ElseIf Сумма = 1 Then
                OutText = OutText + Текст.Cells(i)
            ElseIf Сумма = 2 Then
'                Если нужно игнорировать ноли или пустые ячейки
'                If OutText = 0 Or OutText = "" Then OutText = 1
                If k = 0 Then OutText = 1
                OutText = OutText * Текст.Cells(i)
               
            End If
            k = 1
        End If
    Next i
        If Сумма = 0 Then
            СКЛ_ЯЧ_1 = Left(OutText, Len(OutText) - Len(Delimeter))
        Else
            СКЛ_ЯЧ_1 = OutText
        End If
    'выводим результаты без последнего разделителя
'    СКЛ_ЯЧ_1 = Left(OutText, Len(OutText) - Len(Delimeter))
End Function


Function СКЛ_ЯЧ_2(Текст As Range, Диапазон1 As Range, Ключ1 As String, Диапазон2 As Range, Ключ2 As String, Сумма As Byte)
    Dim Delimeter As String, i As Long
    Delimeter = ", " 'символы-разделители (можно заменить на пробел или ; и т.д.)
     
    'если диапазоны проверки и склеивания не равны друг другу - выходим с ошибкой
    If Диапазон1.Count <> Текст.Count Or Диапазон2.Count <> Текст.Count Then
        СКЛ_ЯЧ_2 = CVErr(xlErrRef)
        Exit Function
    End If
     k = 0
    'проходим по все ячейкам, проверяем все условия и собираем текст в переменную OutText
    For i = 1 To Диапазон1.Cells.Count
        If Диапазон1.Cells(i) Like Ключ1 And Диапазон2.Cells(i) Like Ключ2 Then
            If Сумма = 0 Then
                OutText = OutText & Текст.Cells(i) & Delimeter
            ElseIf Сумма = 1 Then
                OutText = OutText + Текст.Cells(i)
            ElseIf Сумма = 2 Then
'                Если нужно игнорировать ноли или пустые ячейки
'                If OutText = 0 Or OutText = "" Then OutText = 1
                If k = 0 Then OutText = 1
                OutText = OutText * Текст.Cells(i)
            End If
            k = 1
        End If
    Next i
     
    'выводим результаты без последнего разделителя
    If Сумма = 0 Then
        СКЛ_ЯЧ_2 = Left(OutText, Len(OutText) - Len(Delimeter))
    Else
        СКЛ_ЯЧ_2 = OutText
    End If
    
End Function
25.06.2019 17:34:14
Добрый день! Помогите вот с чем. Я делаю склейку, но при растягивании функции учитываются данные скрытых ячеек. Как этого избежать. Пример:
"Текст для сшивания "
                      Столбец 1            Столбец 2            Столбец 3
Строка 1  
Строка 2
Строка 3
Лист 1 Лист 2


На листе 1 хочу получить сшитые данные, которые находятся на листе 2.
Хочу объединить Столбы 1 - 3, но при этом Строка 2 (таких строк конечно может быть много) мне не нужна. Я ее скрываю фильтром, но если я использую формулу =ПРОМЕЖУТОЧНЫЕ.ИТОГИ или =АГРЕГАТ, а потом растягиваю вниз, то происходит сшивание данных и скрытых строк тоже. Как этого избежать?  
07.07.2019 00:37:43
Доброго времени . Прошу помощи с заданием. Имеется база данных по клиентам, где одному клиенту может соответствовать несколько разных дат. Задача состоит в том, чтобы собрать клиента со всеми его датами.      

Таблица                                                                                                             а должно быть так

Продавец1 7/25/2019                                                                   Продавец1 25.07.2019; 03.08.2019; 03.08.2019 7/25/2019
Продавец2 7/26/2019                                                                   Продавец2 7/26/2019 7/26/2019
Продавец3 7/27/2019
Продавец4 7/28/2019
Продавец5 7/29/2019
Продавец6 7/30/2019
Продавец1 7/31/2019
Продавец8 8/1/2019
Продавец9 8/2/2019
Продавец1 8/3/2019
Продавец11 8/4/2019
Продавец5 8/5/2019
07.07.2019 09:35:44
Спасибо,в коменкоммент нашла уже ответ)))
20.02.2021 16:31:26
Добрый день. Можете решить вопрос по построению таблицы?  Имеется примерно такая таблица со множеством параметров и значений.
Уч.лес-воКварталВыделПлощадь выдела, гаОЗУ
Лесничество2170.4берегозащитные участки лесов
Лесничество2210.1берегозащитные участки лесов
Лесничество3120.4берегозащитные участки лесов
Лесничество3130.5берегозащитные участки лесов
Лесничество3140.3глухариный ток
Лесничество3150.4глухариный ток
Лесничество3160.4глухариный ток
Лесничество3177.8глухариный ток
Лесничество3190.4глухариный ток
Лесничество3240.3берегозащитные участки лесов
Лесничество3271.8берегозащитные участки лесов
Лесничество3370.1берегозащитные участки лесов
Лесничество610.2берегозащитные участки лесов
Лесничество6350.1берегозащитные участки лесов
Лесничество6370.1берегозащитные участки лесов
Нужно сделать таблицу в которой будут объединены данные по колонке "Выдел" в одну ячейку при одинаковом ОЗУ и квартале с уч. лесничеством и суммой площади.
Уч.лес-воОЗУКварталВыделПлощадь выдела, га
Лесничествоберегозащитные участки лесов217, 210.5
Лесничествоберегозащитные участки лесов312, 13,24, 27, 373.1
Лесничествоберегозащитные участки лесов61, 35, 370.4
Лесничествоглухариный ток314-17, 199.3
Основной вопрос, как объединить "Выдел", чтобы при последовательности цифр ставился знак "-", а в остальных случаях ",".
Без "-", через сводную и две вспомогательные таблицы результат был получен, но хотелось бы упростить работу и решить вопрос со знаком "-".
20.04.2021 14:56:55
В моем реестре  функция MergeIf  по номеру счета ищет и добавляет все номера пп в оплату счета ( не одно пп.)
количество строк 3000
При автоматических вычислениях сильно подвешивает файл excel  и не дождаться окончательного пересчета формул в чем может  быть причина ?
Как ускорить этот процесс ?
Сейчас приходится руками каждую ячейку в которой есть изменения пересчитывать в ручном режиме.
02.06.2021 17:52:19
Всем доброго времени суток. Есть умная таблица. Нужно информацию каждой ячейки в столбце склеить в одну. Подскажите пожалуйста как это сделать? Пробовал советами выше не выходит. И как добавить скрин?
13.06.2021 18:37:14
Добрый день!
Подскажите, как сделать склейку по 3 условиям.
19.06.2024 11:50:11
Русифицировал функции для удобства, а так же добавил простую проверку на ошибки в ячейках которые сцепляем, чтобы функция не ломалась.
Function СЦЕПИТЬЕСЛИ(СцепитьТекст As Range, Диапазон As Range, Условие As String)
    Dim Delimeter As String, i As Long
    Delimeter = ", "
    If Диапазон.Count <> СцепитьТекст.Count Then
        СЦЕПИТЬЕСЛИ = CVErr(xlErrRef)
        Exit Function
    End If
    For i = 1 To Диапазон.Cells.Count
        If Диапазон.Cells(i) = Условие And Len(Диапазон.Cells(i)) > 0 Then OutText = OutText & IIf(IsError(СцепитьТекст.Cells(i)), "", СцепитьТекст.Cells(i)) & Delimeter
    Next i
    СЦЕПИТЬЕСЛИ = Left(OutText, Len(OutText) - Len(Delimeter))
End Function
Function СЦЕПИТЬЕСЛИМН(СцепитьТекст As Range, Диапазон1 As Range, Условие1 As String, Диапазон2 As Range, Условие2 As String)
    Dim Delimeter As String, i As Long
    Delimeter = ", "
    If Диапазон1.Count <> СцепитьТекст.Count Or Диапазон2.Count <> СцепитьТекст.Count Then
        СЦЕПИТЬЕСЛИМН = CVErr(xlErrRef)
        Exit Function
    End If
    For i = 1 To Диапазон1.Cells.Count
        If Диапазон1.Cells(i) = Условие1 And Диапазон2.Cells(i) = Условие2 Then
            OutText = OutText & IIf(IsError(СцепитьТекст.Cells(i)), "", СцепитьТекст.Cells(i)) & Delimeter
        End If
    Next i
    СЦЕПИТЬЕСЛИМН = Left(OutText, Len(OutText) - Len(Delimeter))
End Function
12.08.2024 14:02:52
Добрый день! Помогите, пожалуйста, решить задачу: у меня есть 2 файла, в одном находятся основные данные(журнал), другой файл - рабочий. Мне нужно, чтобы в рабочем файле, в указанной ячейке, через запятую вставлялись данные из журнала (расположены в одном столбце), выбранные по четырем параметрам, при этом необходимо исключить повторы.  К тому же, в указанной ячейке уже есть формула, которая формирует мне первую часть информации. При возможности хочется, чтобы это всё было в одной ячейке, хотя что-то мне подсказывает, что придется разбивать на две: схемы отдельно, протоколы отдельно


="Исполнительная схема №"&$B$3&"."&$C$3&"."&L12&" от "&ТЕКСТ(F12;"ДД.ММ.ГГГГ")&"г.; протокол испытаний (определение коэффициента уплотнения) №П-457.АК/24 от 03.07.2024, №П-481.АК/24 от 09.07.2024, №П-494.АК/24 от 12.07.2024, №П-554.АК/24 от 30.07.2024" 
т.е. исполнительную схему Excel мне пишет, а протоколы приходится набирать вручную. Нужно, чтобы они в эту ячейку вписывались сами
14.08.2024 20:39:58
Всё огонь... скажите что нужно дописать чтобы удалить дубликаты на выходе в макросе?
Наверх