Excel vba несколько значений в ячейке

Можем ли мы найти и вернуть несколько значений в одной ячейке Excel (через запятую или пробел)?

Мне неоднократно задавали этот вопрос многие мои коллеги и читатели.

В Excel есть несколько удивительных формул поиска, таких как VLOOKUP, INDEX / MATCH (а теперь и XLOOKUP), но ни одна из них не предлагает способ вернуть несколько совпадающих значений. Все они работают, определяя первое совпадение и возвращая его.

Поэтому я немного написал код VBA, чтобы придумать настраиваемую функцию (также называемую функцией, определяемой пользователем) в Excel.

Обновлять: После того, как Excel выпустил динамические массивы и замечательные функции, такие как UNIQUE и TEXTJOIN, теперь можно использовать простую формулу и вернуть все совпадающие значения в одной ячейке (рассматривается в этом руководстве).

В этом руководстве я покажу вам, как это сделать (если вы используете последнюю версию Excel — Microsoft 365 со всеми новыми функциями), а также как это сделать, если вы используете более старые версии ( используя VBA).

Итак, приступим!

Поиск и возврат нескольких значений в одной ячейке (с использованием формулы)

Если вы используете Excel 2016 или предыдущие версии, перейдите к следующему разделу, где я покажу, как это сделать с помощью VBA.

С подпиской на Microsoft 365 ваш Excel теперь имеет гораздо более мощные функции и возможности, которых не было в предыдущих версиях (например, XLOOKUP, динамические массивы, функции UNIQUE / FILTER и т. Д.)

Поэтому, если вы используете Microsoft 365 (ранее известный как Office 365), вы можете использовать методы, описанные в этом разделе, для поиска и возврата нескольких значений в одной ячейке Excel.

И, как вы увидите, это действительно простая формула.

Ниже у меня есть набор данных, в котором есть имена людей в столбце A и обучение, которое они прошли в столбце B.

Щелкните здесь, чтобы загрузить файл с примером, и следуйте инструкциям.

Для каждого человека я хочу узнать, какое обучение они прошли. В столбце D у меня есть список уникальных имен (из столбца A), и я хочу быстро найти и извлечь все тренировки, которые прошел каждый человек, и получить их в одном наборе (разделенном запятой).

Ниже приведена формула, которая сделает это:

= TEXTJOIN (",", ИСТИНА, ЕСЛИ (D2 = $ A $ 2: $ A $ 20, $ B $ 2: $ B $ 20, ""))

После ввода формулы в ячейку E2 скопируйте ее для всех ячеек, в которых вы хотите получить результаты.

Как работает эта формула?

Позвольте мне разобрать эту формулу и объяснить каждую часть того, как она сочетается и дает нам результат.

Логическая проверка в формуле ЕСЛИ (D2 = $ A $ 2: $ A $ 20) проверяет, совпадает ли имя ячейки D2 с ячейкой в ​​диапазоне A2: A20.

Он просматривает каждую ячейку в диапазоне A2: A20 и проверяет, совпадает ли имя в ячейке D2 или нет. если это то же имя, возвращается ИСТИНА, иначе возвращается ЛОЖЬ.

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

{ИСТИНА; ЛОЖЬ; ЛОЖЬ; ИСТИНА; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ; ЛОЖЬ}

Поскольку мы хотим получить обучение только для Боба (значение в ячейке D2), нам нужно получить все соответствующее обучение для ячеек, которые возвращают ИСТИНА в приведенном выше массиве.

Это легко сделать, указав часть [value_if_true] формулы IF в качестве диапазона, в котором есть обучение. Это гарантирует, что если имя в ячейке D2 совпадает с именем в диапазоне A2: A20, формула ЕСЛИ вернет все обучение, которое прошел этот человек.

И везде, где массив возвращает FALSE, мы указали значение [value_if_false] как «» (пусто), поэтому оно возвращает пустое значение.

Часть формулы IF возвращает массив, как показано ниже:

{«Excel»; «»; «»; «PowerPoint»; «»; «»; «»; «»; «»; «»; «»; «»; «»; «»; «»; «»; ””; ””; ””}

Там, где есть названия тренировок, которые прошел Боб, и пробелы там, где имя не было Бобом.

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

И это легко сделать с помощью новой формулы TEXTJOIN (доступной в Excel2021-2022 и Excel в Microsoft 365).

Формула TEXTJOIN принимает три аргумента:

• разделитель — в нашем примере это «», поскольку я хочу, чтобы обучение было разделено запятой и пробелом.
• ИСТИНА — указывает формуле TEXTJOIN игнорировать пустые ячейки и объединять только те, которые не пусты.
• Формула If, возвращающая текст, который необходимо объединить

Если вы используете Excel в Microsoft 365, в котором уже есть динамические массивы, вы можете просто ввести приведенную выше формулу и нажать Enter. А если вы используете Excel2021-2022, вам нужно ввести формулу, удерживая клавиши Control и Shift, а затем нажать Enter.

Щелкните здесь, чтобы загрузить файл с примером, и следуйте инструкциям.

Получить несколько значений поиска в одной ячейке (без повторения)

Поскольку УНИКАЛЬНАЯ формула доступна только для Excel в Microsoft 365, вы не сможете использовать этот метод в Excel2021–2022.

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

В приведенном выше наборе данных некоторые люди проходили обучение несколько раз. Например, Боб и Стэн дважды обучались по Excel, а Бетти дважды обучалась по MS Word. Но в нашем результате мы не хотим, чтобы название тренировки повторялось.

Для этого можно использовать формулу ниже:

= TEXTJOIN (",", ИСТИНА, УНИКАЛЬНО (ЕСЛИ (D2 = $ A $ 2: $ A $ 20, $ B $ 2: $ B $ 20, "")))

Вышеупомянутая формула работает так же, с небольшими изменениями. мы использовали формулу IF в функции UNIQUE, чтобы в случае повторения результата формулы if функция UNIQUE удалила его.

Щелкните здесь, чтобы загрузить файл примера

Поиск и возврат нескольких значений в одной ячейке (с использованием VBA)

Если вы используете Excel 2016 или более ранние версии, у вас не будет доступа к формуле TEXTJOIN. Таким образом, лучший способ затем найти и получить несколько совпадающих значений в одной ячейке — это использовать настраиваемую формулу, которую вы можете создать с помощью VBA.

Чтобы получить несколько значений поиска в одной ячейке, нам нужно создать функцию в VBA (аналогичную функции VLOOKUP), которая проверяет каждую ячейку в столбце и, если значение поиска найдено, добавляет его к результату.

Вот код VBA, который может это сделать:

Код от Sumit Bansal (https://trumpexcel.com) Функция SingleCellExtract (Lookupvalue As String, LookupRange As Range, ColumnNumber as Integer) Dim i As Long Dim Result As String For i = 1 To LookupRange.Columns (1) .Cells .Count Если LookupRange.Cells (i, 1) = Lookupvalue Then Result = Result & "" & LookupRange.Cells (i, ColumnNumber) & "," End If Next i SingleCellExtract = Left (Result, Len (Result) - 1) Конечная функция

Куда положить этот код?

1. Откройте книгу и нажмите Alt + F11 (откроется окно редактора VBA).
2. В этом окне редактора VBA слева есть проводник проекта (в котором перечислены все книги и рабочие листы). Щелкните правой кнопкой мыши любой объект в книге, где вы хотите, чтобы этот код работал, и выберите Вставить -> Модуль.
3. В окне модуля (которое появится справа) скопируйте и вставьте приведенный выше код.
4. Теперь все готово. Перейдите в любую ячейку книги и введите = SingleCellExtract и вставьте необходимые входные аргументы (например, LookupValue, LookupRange, ColumnNumber).

Как работает эта формула?

Эта функция работает аналогично функции ВПР.

В качестве входных данных он принимает 3 аргумента:

1. Lookupvalue — Строка, которую нам нужно найти в диапазоне ячеек.
2. LookupRange — Массив ячеек, из которых нам нужно получить данные (в данном случае $ B3: $ C18).
3. ColumnNumber — Это номер столбца таблицы / массива, из которого должно быть возвращено совпадающее значение (в данном случае 2).

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

Воспоминание: Сохраните книгу как книгу с поддержкой макросов (.xlsm или .xls), чтобы снова использовать эту формулу. Кроме того, эта функция будет доступна только в этой книге, а не во всех книгах.

Щелкните здесь, чтобы загрузить файл примера

Узнайте, как автоматизировать скучные повторяющиеся задачи с помощью VBA в Excel. Присоединяйся к Курс Excel VBA

Получить несколько значений поиска в одной ячейке (без повторения)

Есть вероятность, что у вас могут быть повторы в данных.

Если вы используете приведенный выше код, он также даст вам повторы в результате.

Если вы хотите получить результат без повторов, вам нужно немного изменить код.

Вот код VBA, который предоставит вам несколько значений поиска в одной ячейке без каких-либо повторений.

'Код от Sumit Bansal (https://trumpexcel.com) Функция MultipleLookupNoRept (Lookupvalue As String, LookupRange As Range, ColumnNumber as Integer) Dim i As Long Dim Result As String For i = 1 To LookupRange.Columns (1) .Cells .Count If LookupRange.Cells (i, 1) = Lookupvalue Then For J = 1 To i - 1 If LookupRange.Cells (J, 1) = Lookupvalue Then If LookupRange.Cells (J, ColumnNumber) = LookupRange.Cells (i, ColumnNumber) Then GoTo Skip End If End If Next J Result = Result & "" & LookupRange.Cells (i, ColumnNumber) & "," Skip: End If Next i MultipleLookupNoRept = Left (Result, Len (Result) - 1) End Функция

После того, как вы разместите этот код в редакторе VB (как показано выше в руководстве), вы сможете использовать MultipleLookupNoRept функция.

Вот снимок результата, который вы получите с этим MultipleLookupNoRept функция.

Щелкните здесь, чтобы загрузить файл примера

В этом руководстве я рассказал, как использовать формулы и VBA в Excel для поиска и возврата нескольких значений подстановки в одной ячейке в Excel.

Хотя это легко сделать с помощью простой формулы, если вы используете Excel в подписке Microsoft 365, но если вы используете предыдущие версии и не имеете доступа к таким функциям, как TEXTJOIN, вы все равно можете сделать это с помощью VBA, создав свой собственная пользовательская функция.

Я использовал твою выпивку и немного больше здесь.

Sub EmptyCells()
    Dim lrow As Long, lcol As Long
    Dim i As Integer, r As Long, c As Long
    Dim reString As String

    With Worksheets("sheet1")
        'Find the last non-blank cell in Column "School"
        lrow = .Cells(.Rows.Count, 3).End(xlUp).Row
        lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        MsgBox "Last Row: " & lrow

        For r = 2 To lrow
            reString = vbnullstring
            For c = 1 To lcol
                If IsEmpty(.Cells(r, c)) Then
                    'MsgBox .Cells(r, c).Address(0,0) & " is empty. " & _
                            "The cell row number is " & r & "." & vblf & _
                            "The column header is " & .Cells(1, c).value
                    reString = reString & ", " & .Cells(1, c).Value
                End If
            Next c
            .Cells(r, c) = Mid(reString, 3)
        Next r
    End With

    MsgBox "Complete"

End Sub

По умолчанию вы можете выбрать только один элемент в раскрывающемся списке проверки данных в Excel. Как вы можете сделать несколько вариантов выбора в раскрывающемся списке, как показано ниже? Методы, описанные в этой статье, могут помочь вам решить проблему.

Создать раскрывающийся список с несколькими вариантами выбора с кодом VBA

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

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

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

2. в Microsoft Visual Basic для приложений окно, скопируйте приведенный ниже код VBA в окно кода. Смотрите скриншот:

Код VBA 1: разрешить множественный выбор в раскрывающемся списке без дубликатов

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2019/11/13
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or _
                   InStr(1, xValue1, ", " & xValue2) Or _
                   InStr(1, xValue1, xValue2 & ",") Then
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & ", " & xValue2
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

3. нажмите другой + Q ключи, чтобы закрыть Microsoft Visual Basic для приложений окно.

Теперь вы можете выбрать несколько элементов из раскрывающегося списка на текущем листе.

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

Код VBA 2: разрешить множественный выбор в раскрывающемся списке без дубликатов (удалить существующие элементы, выбрав его снова)

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2023/01/11
    'Updated by Ken Gardner 2022/07/11
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim semiColonCnt As Integer
    Dim xType As Integer
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    
    xType = 0
    xType = Target.Validation.Type
    If xType = 3 Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or xValue1 = xValue2 & ";" Or xValue1 = xValue2 & "; " Then ' leave the value if only one in list
                    xValue1 = Replace(xValue1, "; ", "")
                    xValue1 = Replace(xValue1, ";", "")
                    Target.Value = xValue1
                ElseIf InStr(1, xValue1, "; " & xValue2) Then
                    xValue1 = Replace(xValue1, xValue2, "") ' removes existing value from the list on repeat selection
                    Target.Value = xValue1
                ElseIf InStr(1, xValue1, xValue2 & ";") Then
                    xValue1 = Replace(xValue1, xValue2, "")
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & "; " & xValue2
                End If
                Target.Value = Replace(Target.Value, ";;", ";")
                Target.Value = Replace(Target.Value, "; ;", ";")
                If Target.Value <> "" Then
                    If Right(Target.Value, 2) = "; " Then
                        Target.Value = Left(Target.Value, Len(Target.Value) - 2)
                    End If
                End If
                If InStr(1, Target.Value, "; ") = 1 Then ' check for ; as first character and remove it
                    Target.Value = Replace(Target.Value, "; ", "", 1, 1)
                End If
                If InStr(1, Target.Value, ";") = 1 Then
                    Target.Value = Replace(Target.Value, ";", "", 1, 1)
                End If
                semiColonCnt = 0
                For i = 1 To Len(Target.Value)
                    If InStr(i, Target.Value, ";") Then
                        semiColonCnt = semiColonCnt + 1
                    End If
                Next i
                If semiColonCnt = 1 Then ' remove ; if last character
                    Target.Value = Replace(Target.Value, "; ", "")
                    Target.Value = Replace(Target.Value, ";", "")
                End If
            End If
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Заметки:

Легко создавайте раскрывающийся список с несколькими вариантами выбора с помощью замечательного инструмента

Здесь мы настоятельно рекомендуем Раскрывающийся список с множественным выбором особенность Kutools for Excel для вас. С помощью этой функции вы можете легко выбрать несколько элементов из раскрывающегося списка в указанном диапазоне, текущем листе, текущей книге или всех открытых книгах по мере необходимости.

1. Нажмите Кутулс > Раскрывающийся список > Раскрывающийся список с множественным выбором > Настройки. Смотрите скриншот:

2. в Настройки раскрывающегося списка с множественным выбором диалоговое окно, настройте следующим образом.

• 2.1) Укажите область применения в Обращаться к раздел. В этом случае я выбираю Текущий рабочий лист из Указанный объем раскрывающийся список;
• 2.2). Направление текста раздел выберите направление текста в зависимости от ваших потребностей;
• 2.3). Разделитель поле введите разделитель, который вы будете использовать для разделения нескольких значений;
• 2.4) Проверьте Не добавляйте дубликаты коробка в Опции раздел, если вы не хотите дублировать ячейки выпадающего списка;
• 2.5) Нажмите OK кнопка. Смотрите скриншот:

3. Щелкните Кутулс > Раскрывающийся список > Раскрывающийся список с множественным выбором для включения функции.

Теперь вы можете выбрать несколько элементов из раскрывающегося списка на текущем листе или в любой области, указанной на шаге 2.

  Если вы хотите получить бесплатную пробную версию (30-день) этой утилиты, пожалуйста, нажмите, чтобы загрузить это, а затем перейдите к применению операции в соответствии с указанными выше шагами.

Статьи по теме:

Хитрости »

1 Май 2011              163969 просмотров

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

Все чаще вижу на разных форумах вопросы типа: Есть таблица, в одном столбце фамилии, в другом оценки(виды работ и т.д.). Как сцепить в одной ячейке для каждой фамилии только принадлежащие ей оценки? Или собрать в одну ячейку через запятую фамилии всех сотрудников одного отдела, но все сотрудники идут вразнобой. Т.е. из такой таблицы:

Получить такую:

Стандартными функциями это сделать весьма проблематично, т.к. заранее неизвестно сколько будет этих оценок и фамилий.. 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,»»))
так же это можно использовать в Excel 2019 в случае, если функция ФИЛЬТР отсутствует — да, может быть и такое, хоть Microsoft и пишет, что она там поддерживается
Аргументы точно такие же, как в формуле выше. Правда эта формула вводится в ячейку как формула массива(т.е. одновременным нажатием трех клавиш 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 624 скачиваний)

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

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

    Видеоуроки

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



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