JayBhagavan,все же вернулся к вопросу. Пробовал изменить макрос. Но выдает не то. Не могли бы Вы пояснить, как задать правильно массив данных для отбора в словарь?
Скрытый текст
Код
Sub jjj()
Set wsh_out = ThisWorkbook.Worksheets("Лист1")
wsh_out.Cells.Delete
Set rng_out = wsh_out.[A1]
Set rng_partcpnt = [Конкурсы!C6:N30]
Set rng_tndr = [B:B]
Set dict_partcpnt = CreateObject("Scripting.Dictionary")
For Each cl In rng_partcpnt
With cl
tmp_str$ = .Value
If Len(tmp_str) > 1 Then
If Not dict_partcpnt.exists(tmp_str) Then
dict_partcpnt(tmp_str) = ""
End If
End If
End With ' cl
Next cl
For Each dc In dict_partcpnt.keys
With rng_partcpnt
Set var_find = .Find(What:=dc, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not var_find Is Nothing Then
str_first_address$ = var_find.Address
Do
dict_partcpnt(dc) = dict_partcpnt(dc) & _
IIf(Len(dict_partcpnt(dc)) > 0, Chr(10), "") & rng_tndr.Cells(var_find.Row)
Set var_find = .FindNext(var_find)
Loop While Not var_find Is Nothing And str_first_address <> var_find.Address
End If
End With
arr = Split(dict_partcpnt(dc), Chr(10))
rng_out.Value = dc
i_1 = LBound(arr)
i_n = UBound(arr)
For i = i_1 To i_n
Set rng_out = rng_out.Offset(1)
rng_out.Value = arr(i)
Next i
Set rng_out = rng_out.Offset(1 - rng_out.Row, 1)
Next dc
wsh_out.UsedRange.Columns.AutoFit
wsh_out.Select
End Sub
karcevgo, для того чтобы вникнуть в вопрос 20-тидневной давности мне нужно время. Лучше предоставьте файл-пример с сохранением структуры того что есть и что должно получится в итоге, на которой макрос НЕ работает.
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori