Страницы: 1
RSS
Автоматическая выборка уникальных значений
 
Добрый день!
Есть некий столбец неопределенной длины, в котором каждая ячейка содержит некоторое количество слов (поисковые запросы).
Нужно получить в итоге столбец с уникальными словами, сортированный по алфавиту.
То есть, разбить каждую ячейку на отдельные слова, собрать их в один столбец, удалить дубликаты и сортировать.
Обращаюсь за помощью, так как моих знаний хватает только на то, чтобы записать макрос, выполняя это вручную. Но он не масштабируется (количество запросов и количество слов в них может быть практически любым).
Можете подсказать готовое решение (макрос, например)? Спасибо.

Было/стало на пике:
Изменено: Василий Теркин - 03.05.2021 19:13:04
 
сейчас пример попросят-
 
А для чего это нужно?
Какое практическое применение?
Макрос можно за 5 минут написать - но смысла не вижу.
 
Ну, если бы это не было нужно, я бы не создавал тему, рискуя разгневать табличных богов.
А вообще я так минус-слова для поисковой рекламы собираю, для отчетности. Берется список ключевиков, по которым показана реклама за месяц, применяется вышеописанный скрипт; после результат фильтруется на предмет нецелевых запросов, оные заносятся в РК, объявления не показываются тем, у кого в запросе неугодные слова. В теории и иногда на практике это снижает расходы.  
 
По правилам форума нужен файл-пример, а не скриншот.
 
Добавил в пост.
 
Marat Ta, не видите смысла? А какой смысл в Вашем #3?
 
Цитата
Можете подсказать готовое решение (макрос, например)?
Код
Sub test()
Dim arr
Dim arr1
Dim dic As Object
Dim i As Long
Dim j As Long
Dim iLastRow As Long
Dim iWord As String
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
     Range("B1:B" & iLastRow).ClearContents
     Set dic = CreateObject("Scripting.Dictionary"): dic.comparemode = 1
     arr = Range("A1:A" & iLastRow).Value
  For i = 1 To UBound(arr)
    arr1 = Split(arr(i, 1), " ")
    For j = 0 To UBound(arr1)
      dic.Item(arr1(j)) = dic.Item(arr1(j))
    Next j
  Next i
   Range("B1").Resize(dic.Count) = Application.Transpose(dic.keys)
   iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Range("B1:B" & iLastRow).Sort key1:=Range("B1"), Order1:=xlAscending
End Sub

Результат на листе Было в столбце В
 
Kuzmich, спасибо!  
Страницы: 1
Наверх