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

 

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

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

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

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

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

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

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

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

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

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

Добавил: nilem |
Просмотров: 9911 | Рейтинг: 5.0/1
Всего комментариев: 4
Спам-сообщение скрыто. Показать
Спам +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

Спам +1  
3    Jack_Famous_007   (21.10.2017 00:57) [ Материал]
   как вариант

Спам 0  
4    Ivan28rus89   (02.05.2019 06:34) [ Материал]
   Спасибо большое.

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