Lost your password?


Хитрости »
Основные понятия (26)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (20)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (4)

Как сцепить несколько значений в одну ячейку по критерию? СцепитьЕсли

Все чаще вижу на разных форумах вопросы типа: Есть таблица, в одном столбце фамилии, в другом оценки(виды работ и т.д.). Как сцепить в одной ячейке для каждой фамилии только принадлежащие ей оценки? Или собрать в одну ячейку через запятую фамилии всех сотрудников одного отдела, но все сотрудники идут вразнобой. Т.е. из такой таблицы:
Исходная таблица
Получить такую:
Результат
Стандартными функциями это сделать весьма проблематично, т.к. заранее неизвестно сколько будет этих оценок и фамилий.. MIcrosoft работает над усовершенствованием Excel и теперь стало возможным сделать это и стандартными функциями. Правда, с небольшими ограничениями: сделать это могут только пользователи Excel 2019 и выше или Office 365 по подписке. В итоге счастливые обладатели новейших версий могут использовать достаточно несложные формулы:
=ОБЪЕДИНИТЬ("; ";1;ФИЛЬТР(B2:B20;A2:A20=A2;""))
=TEXTJOIN("; ",1,FILTER(B2:B20,A2:A20=A2,""))

Аргументы функции:

  • ("; ") - символ(или несколько символов), которым необходимо объединять найденные значения
  • (A2:A20) - диапазон, в котором искать критерий
  • (A2) - критерий. Значение, на основании которого необходимо сцеплять значения. Значение просматривается в диапазоне значений(A2:A20)
  • (B2:B20) - из этого диапазона берется значение для сцепления, если значение напротив в диапазонe(A2:A20) совпадает с искомым значением A2

Для любителей "старой школы" можно вместо функции ФИЛЬТР(FILTER) использовать стандартную ЕСЛИ(IF):
=ОБЪЕДИНИТЬ("; ";1;ЕСЛИ(A2:A20=A2;B2:B20;""))
=TEXTJOIN("; ",1,IF(A2:A20=A2,B2:B20,""))

Аргументы точно такие же, как в формуле выше. Правда эта формула вводится в ячейку как формула массива(т.е. одновременным нажатием трех клавиш Ctrl+Shift+Enter).
Хотя в самых новых версия(а-ля 365) это уже не обязательно - Excel сам поймет, что требуется обработка массива ячеек.


А для пользователей Excel 2016 и ниже я написал небольшую функцию пользователя на VBA, которая решает данную проблему. Так же подобную функцию называют "многоразовый ВПР", потому что она по критерию возвращает ВСЕ значения для этого критерия, а не только первое.

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          http://www.excel-vba.ru
' Purpose:
'---------------------------------------------------------------------------------------
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)
        If IsNumeric(Критерий) And Критерий <> "" Then
            Критерий = CDbl(Критерий)
        End If
        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

Чтобы правильно использовать приведенный код, необходимо сначала ознакомиться со статьей Что такое функция пользователя(UDF)?. Вкратце: скопировать текст кода выше, перейти в редактор VBA(Alt+F11) -создать стандартный модуль(Insert -Module) и в него вставить скопированный текст. После чего функцию СцепитьЕсли можно будет вызвать из Диспетчера функций(Shift+F3), отыскав её в категории Определенные пользователем (User Defined Functions).
Синтаксис записи в ячейку листа:
=СцепитьЕсли(A2:A20;A2;B2:B20;"-";0)

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

Диапазон(A2:A20) - диапазон, в котором искать критерий(указывается один столбец)

Критерий(A2) - критерий. Значение, на основании которого необходимо сцеплять значения. Может содержать символы подстановки - * и ? и символы сравнения (<>"", <23, >0, "<>"&A1 и т.п.). Просматривается Диапазон. При совпадении значения ячейки в Диапазоне значение из Диапазона_Сцепления добавляется к результату с выбранным разделителем.

Диапазон_сцепления(B2:B20) - из этого диапазона берется значение для сцепления, если значение в аргументе Диапазон совпадает с аргументом Критерий(указывается один столбец). Если в Диапазоне значение 5-ой строки совпадает с критерием, то из Диапазона_Сцепления будет взято так же значение из 5-ой строк этого диапазона и сцеплено с результатом.

Разделитель("-") - По умолчанию пробел, но можно задать любой другой символ или группу символов.

БезПовторов - если указать 1 или ИСТИНА, то в результате получится строка, в которой нет одинаковых значений. Если указать 0 или ЛОЖЬ, то будут выведены все значения. По умолчанию значение ЛОЖЬ.

Примечание: для работы функции должны быть разрешены макросы

Скачать пример

  Пример СцепитьЕсли.xls (68,0 KiB, 15 172 скачиваний)


Также см.:
ВПР_МН
Сцепить_МН
СцепитьЕсли
Что такое функция пользователя(UDF)?
ВПР с возвратом всех значений


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 90 комментариев
  1. Павел:

    С П А С И Б О!!!
    я уж думал сам запариться над макросом....но вот наткнулся на эту реализацию.
    5+

  2. Денис:

    а можно ли оставить только крайние числа, сделать так 1-6, вместо 1, 2, 3, 4, 5, 6?

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

  4. Альт-Стар:

    КАК ВАС БЛАГОДАРИТЬ?

    АПЛОДИРУЕМ СТОЯ!!!!!!!!!!

  5. Надежда:

    Огромное спасибо за формулу!
    А может подскажите, как правильно написать код, чтобы было 2 диапазона условия?
    т.е. диапазон1; Критерий1; диапазон2; Критерий2;
    как в СуммЕслиМН. оеально это сделать? спасибо!

  6. Надежда, только правкой кода.

  7. Екатерина:

    Автор, реальный тебе РЕСПЕКТ!!!!!
    Бью поклоны за избавление от ручного сцепления 3,5 тысяч значений!
    СПАСИБО!!!!!!!

  8. Макс:

    Отличная функция, но работает если данные на одном листе. Не получилось ни с разных файлов сравнивать (тупо вылетает Excel по ошибке), ни с разных листов....

  9. Макс, а функция и не сравнивает. Она берет данные для просмотри и сцепления с одного листа. Критерии при этом могут быть откуда угодно. Что у Вас там вылетает не знаю.

    • Макс:

      Если ячеек более 37000 то функция не срабатывает, это факт. Причем если критерии находятся в другом файле, то Excel вываливается по ошибке. Вместо того что придираться к словам обратили бы внимание на свои ошибки. Удачи Вам.

  10. Макс, как скажете. Не буду придираться. Но сравнивать и сцеплять понятия разные - кто знает как Вы поняли функцию и для чего применить пытаетесь. Может Вы хотите навязать ей то, чего она не умеет. Поэтому я уточнил, но нисколько не придирался. Не надо по себе людей судить.
    И вот другой факт: у меня функция РАБОТАЕТ. И не только у меня, судя по комментариям. Без Вашего примера сказать почему не работает у Вас нереально. Может у Вас книги в разных процессах открыты. А может еще что.
    Плюс, если у Вас так много значений - есть вероятность, что результирующая строка содержит больше символов, чем допускается для записи в ячейку. И функция просто завершается с ошибкой, т.к. не может занести данные. Ничего с этим не сделать, т.к. это ограничения самого Excel.
    И еще момент: нехватка свободной памяти для обработки таких объемных данных. VBA просто не может поместить их в массивы.

    P.S. Про "обратили бы внимание на свои ошибки". А Вам не кажется, что я ничем Вам не обязан, чтобы что-то для Вас лично исправлять? Функция не работает только у Вас. Причины я описал выше. Хотите с ними разобраться - выкладывайте файл со своими данными на файлообменник, а ссылку на него сюда. Не забудьте прописать там функцию. Я скачаю, посмотрю. И тогда будет видно, где и чья ошибка.

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2022 Excel для всех   Войти