Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 35704
Главная » Готовые решения » VBA » Пользовательские функции

Конкатенация уникальных значений из диапазона в строку с разделителем
30.08.2013, 16:02
[ Файл-пример (20.0Kb) ]

объединить уникальные значения из диапазона в строку с разделителем (разделитель по умолчанию ";"):

Function JoinWithoutDuplicates(rng As Range, Optional sep As String = "; ") As String
Dim x, v, s As String
x = Intersect(rng, ActiveSheet.UsedRange).Value: s = sep
For Each v In x
 v = Trim$(v)
 If Len(v) Then If InStr(s, sep & v & sep) = 0 Then s = s & v & sep
Next
JoinWithoutDuplicates = Mid(s, Len(sep) + 1, Len(s) - Len(sep) * 2)
End Function

объединить уникальные из диапазона по искомому значению в строку с разделителем (что-то типа ВПР):

Public Function ertert(SearchValue, rng As Range, k As Long, Optional sep As String = "; ") As String 'напряженка с названиями :)
Dim x, v, s As String, i As Long
x = Intersect(rng, rng.Worksheet.UsedRange).Value: s = sep
For i = 1 To UBound(x)
 If x(i, 1) = SearchValue Then
 If Len(x(i, k)) Then
 If InStr(s, sep & x(i, k) & sep) = 0 Then
 s = s & x(i, k) & sep
 End If
 End If
 End If
Next i
If Len(s) > Len(sep) Then ertert = Mid(s, Len(sep) + 1, Len(s) - Len(sep) * 2)
End Function

пример в студии :)

Добавил: nilem |
Просмотров: 3783 | Рейтинг: 0.0/0
Всего комментариев: 2
Спам-сообщение скрыто. Показать
+2   Спам
1    MCH   (26.09.2013 23:55)
   вариант

Function JoinWithoutDuplicates(rng As Range, Optional sep As String = "; ") As String
Dim v
With CreateObject("Scripting.Dictionary")
For Each v In Intersect(rng, rng.Worksheet.UsedRange).Value
If Len(v) Then .Item(v) = 0
Next v
JoinWithoutDuplicates = Join(.keys, sep)
End With
End Function

0   Спам
2    AleX_Leon   (22.11.2014 16:23)
   Спасибо большое! clap

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!