Сцепление текстовых значений при двух условиях

[diop]

ЗДРАВСТВУЙТЕ.

необходимо сцепить текстовые ячейки в столбце "итоги-1" на листе2
при вводе условий "месяц2" и "значение1"

используя данные листа1

для WORD2003

[IgorGO]

см.вложение

[diop]

Сообщение от IgorGO

см.вложение

спасибо за интересное решение задачи.
а можно через формулу и массивы.

ибо если изменить значения на первом листе то необходимо также обновление данных столбца "итог-1"

[IgorGO]

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

[diop]

Сообщение от IgorGO

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

прошу извинения, Игорь,
но я так делал, то тогда почему при изменении на Лист1 автоматически не изменяются данные на Лист2.

[diop]

Сообщение от diop

прошу извинения, Игорь,
но я так делал, то тогда почему при изменении на Лист1 автоматически не изменяются данные на Лист2.

то как можно заставить автоматически обновлять данные.

[IgorGO]

может как-то так

[diop]

Сообщение от IgorGO

может как-то так

а что если переделать следующую функцию под следующие параметры

диапазон указывает не 1 столбец, а два которые стоят рядом, а критерий не 1 ячейка а две (стоящие рядом "С4:D4" напримет)

'---------------------------------------------------------------------------------------
' Procedure : СцепитьЕсли
' Author : The_Prist(Дмитрий); http://www.excel-vba.ru
' Purpose : Функция сцепляет данные из диапазона, указанного критерием Диапазон_сцепления
' в том случае, если ячейка из критерия Диапазон входит в условие
' указанное Критерием. В качекстве Критерия может быть ссылка на ячейку,
' либо текст/число, либо операторы сравнения
' (как все привыкли в СУММЕСЛИ, СЧЁТЕСЛИ и т.д. - "<>""",">8" и пр.).
'---------------------------------------------------------------------------------------
Function СцепитьЕсли(ByRef Диапазон As Range, ByVal Критерий As String, ByRef Диапазон_сцепления As Range, Optional Разделитель As String = " ") As String
Dim li As Long, sStr As String, avItem, avDateArr(), avRezArr(), lUBnd As Long
If Диапазон.Count > 1 Then
avDateArr = Intersect(Диапазон, Application.Caller.Parent.UsedRange ).Value
avRezArr = Intersect(Диапазон_сцепления, Application.Caller.Parent.UsedRange ).Value
If Диапазон.Rows.Count = 1 Then
avDateArr = Application.Transpose(avDateArr)
avRezArr = Application.Transpose(avRezArr)
End If
Else
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
СцепитьЕсли = sStr
End Function