Добрый день! Есть некий столбец неопределенной длины, в котором каждая ячейка содержит некоторое количество слов (поисковые запросы). Нужно получить в итоге столбец с уникальными словами, сортированный по алфавиту. То есть, разбить каждую ячейку на отдельные слова, собрать их в один столбец, удалить дубликаты и сортировать. Обращаюсь за помощью, так как моих знаний хватает только на то, чтобы записать макрос, выполняя это вручную. Но он не масштабируется (количество запросов и количество слов в них может быть практически любым). Можете подсказать готовое решение (макрос, например)? Спасибо.
Ну, если бы это не было нужно, я бы не создавал тему, рискуя разгневать табличных богов. А вообще я так минус-слова для поисковой рекламы собираю, для отчетности. Берется список ключевиков, по которым показана реклама за месяц, применяется вышеописанный скрипт; после результат фильтруется на предмет нецелевых запросов, оные заносятся в РК, объявления не показываются тем, у кого в запросе неугодные слова. В теории и иногда на практике это снижает расходы.
Можете подсказать готовое решение (макрос, например)?
Код
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