Это может быть выполнено без какого-либо VBA с помощью функции TEXTJOIN()
представленной в Excel 2016. Если у вас нет этой версии Excel, вы можете установить UDF с поли-заливкой. Я поставил основной в конце этого ответа.
Array-введите следующую формулу в E2
:
{=TEXTJOIN(", ",TRUE,IFERROR(INDEX(A1:A5,N(IF(1,SMALL(IFERROR(1/(1/((B1:B5=D2)*ROW(B1:B5))),FALSE),ROW(INDEX(E:E,1):INDEX(E:E,ROWS(B1:B5))))))),""))}
Предварительно подтвержденная формула выглядит следующим образом:
{=
TEXTJOIN(
", ",
TRUE,
IFERROR(
INDEX(
A1:A5,
N(IF(1,
SMALL(
IFERROR(1/(1/((B1:B5=D2)*ROW(B1:B5))),FALSE),
ROW(INDEX(E:E,1):INDEX(E:E,ROWS(B1:B5)))
)
))
),
""
)
)}
Заметки:
- Предварительно подтвержденная формула действительно работает, если введена.
Моя версия текстового UDF TEXTJOIN()
:
'============================================================================================
' Module : <any standard module>
' Version : 0.1.1
' Part : 1 of 1
' References : Optional - Microsoft VBScript Regular Expressions 5.5 [VBScript_RegExp_55]
' Source : https://superuser.com/a/1331555/763880
'============================================================================================
Public Function TEXTJOIN( _
ByRef delimiter As String, _
ByRef ignore_empty As Boolean, _
ByRef text1 As Variant _
) _
As String
Dim ƒ As Excel.WorksheetFunction: Set ƒ = Excel.WorksheetFunction
Const DELIMITER_ As String = "#"
Const PATTERN_ As String = "^(?:#)+|(?:#)+$|(#){2,}"
Static rexDelimiterEscaper As Object ' VBScript_RegExp_55.RegExp ' ## Object
Static rexEmptyIgnorer As Object ' VBScript_RegExp_55.RegExp ' ## Object
If rexEmptyIgnorer Is Nothing _
Then
Set rexEmptyIgnorer = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp ' ## CreateObject("VBScript.RegExp")
With rexEmptyIgnorer
.Global = True
.Pattern = PATTERN_ ' Replacement = "$1"
End With
Set rexDelimiterEscaper = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp ' ## CreateObject("VBScript.RegExp")
With rexDelimiterEscaper
.Global = True
.Pattern = "(.)" ' Replacement = "\$1"
End With
End If
Dim varText1 As Variant
Select Case TypeName(text1)
Case "Range":
varText1 = ƒ.Transpose(text1.Value2)
If text1.Rows.Count = 1 Then
varText1 = ƒ.Transpose(varText1)
If text1.Columns.Count = 1 Then varText1 = Array(varText1)
End If
Case "Variant()":
On Error Resume Next
If LBound(text1, 2) <> LBound(text1, 2) Then
varText1 = text1
Else
varText1 = ƒ.Transpose(text1)
End If
On Error GoTo 0
Case Else:
varText1 = Array(text1)
End Select
If ignore_empty _
Then
With rexEmptyIgnorer
.Pattern = Replace(PATTERN_, DELIMITER_, rexDelimiterEscaper.Replace(delimiter, "\$1"))
TEXTJOIN = .Replace(Join(varText1, delimiter), "$1")
End With
Else
TEXTJOIN = Join(varText1, delimiter)
End If
End Function
Заметки:
- Это не правильный поли-наполнитель:
- Первые два аргумента не являются обязательными;
- Если вы не хотите использовать разделитель, вы должны передать пустую строку в качестве первого параметра.
- Допустим только один другой (также обязательный) аргумент.
- Для третьего аргумента вы можете передать что угодно, кроме многомерного массива / диапазона. Это приведет к #
#VALUE!
ошибка.
- Он должен быть очень быстрым, особенно для больших входов, поскольку он не использует петли. Если вы не игнорируете пустые значения, это будет молниеносно. Игнорирование их будет медленнее, так как необходимо использовать пару регулярных выражений и дополнительные манипуляции со строками.