Слово Том лучше удалить из ячейки или использовать его и в исходных данных. Это и для возможных формул будет полезно)
В функции разделитель 'запятая' можно заменить на нужный Вам
Скрытый текст |
---|
Код |
---|
Function СЦЕПИТЬЕСЛИМН(rngU As Range, ParamArray Conditions()) As String
'rngU - диапазон сцепления
'Conditions() - массив ПАР значений вида: Диапазон_Условий1;Условие1;Диапазон_Условий2;Условие2...Диапазон_УсловийN;УсловиеN, обязательный
' должен иметь хотя-бы одну пару значений.
'Разделителем найденных уникальных значений является ', ' (запятая с пробелом)
'Все диапазоны должны состоять из одного столбца и иметь равное кол-во строк
'Для текстовых условий допустимы знаки подстановки
Dim cl()
Dim arrFlag() As Boolean
Dim I&, J&
Dim iVal, iZn$, iStr$
On Error Resume Next
cl = rngU.Value
For I = 1 To UBound(cl)
ReDim arrFlag(Int(UBound(Conditions) / 2))
For J = LBound(Conditions) To UBound(Conditions) Step 2
iVal = rngU.Parent.Cells(rngU(I).Row, Conditions(J).Column).Value
Select Case True
Case IsNumeric(iVal)
iVal = Replace(iVal, ",", ".")
iZn = IIf(WorksheetFunction.And(Left(Conditions(J + 1), 1) <> ">", Left(Conditions(J + 1), 1) <> "<"), "=", vbNullString)
iStr = iVal & iZn & Conditions(J + 1)
arrFlag(Int(J / 2)) = Application.Evaluate(iStr)
Case Else
iStr = IIf(Left(Conditions(J + 1), 1) = "<", Mid(Conditions(J + 1), 3, Len(Conditions(J + 1)) - 2), Conditions(J + 1))
arrFlag(Int(J / 2)) = IIf(Left(Conditions(J + 1), 1) = "<", Not (iVal Like iStr), iVal Like iStr)
End Select
Next
If WorksheetFunction.And(arrFlag) = True Then СЦЕПИТЬЕСЛИМН = IIf(СЦЕПИТЬЕСЛИМН <> Empty, СЦЕПИТЬЕСЛИМН & ", " & cl(I, 1), cl(I, 1))
Next
End Function
|
|