В столбце А есть список названий в которых дублируются некоторые слова или несколько слов, которые идут друг за другом. Слова могут быть в разном регистре, вот так:
Как можно убрать дубли слова/нескольких слов, которые идут друг за другом? Заранее благодарен за помощь
Мне кажется, что пробел_внутри "Кожаная косметичка клатч THE Xthex black" => "Кожаная косметичка клатч the x black" сильно усложняет задачу... Хотя мне сложно судить о возможностях макросов... ================== Я бы попытался подумать о возможностях регулярных выражений ================== В качестве решения можно попробовать составить словарь всех слов, встречающихся в массиве данных (исключения типа THE X в словарь можно добавить руками), а затем анализировать количество вхождений каждого из слов внутри каждого из текстов (и при необходимости расстояние между вхождениями)... На мой взгляд из-за своей комплексности данная задача выходит за рамки этого раздела
Можно решить макросом через использование коллекции и их неприятия дубликатов.
Скрытый текст
Код
Sub DelDoubleWords()
Dim arrIn, arrS, colIn As New Collection, lngI As Long, lngJ As Long
arrIn = Range("A2:A" & Range("A1").CurrentRegion.Rows.Count).Value
For lngI = 1 To UBound(arrIn, 1)
arrS = Split(arrIn(lngI, 1), " ")
For lngJ = 0 To UBound(arrS, 1)
On Error Resume Next
colIn.Add Item:=LCase(arrS(lngJ)), Key:=LCase(arrS(lngJ))
Next lngJ
arrIn(lngI, 1) = ""
For lngJ = colIn.Count To 1 Step -1
arrIn(lngI, 1) = colIn.Item(lngJ) & " " & arrIn(lngI, 1)
colIn.Remove (lngJ)
Next lngJ
arrIn(lngI, 1) = UCase(Left(arrIn(lngI, 1), 1)) & Mid(arrIn(lngI, 1), 2, Len(arrIn(lngI, 1)) - 2)
Next lngI
Range("B2").Resize(UBound(arrIn, 1), 1) = arrIn
End Sub
Function DelDouble$(s$)
Dim re, ms: DelDouble = s
Set re = CreateObject("VBScript.RegExp"): re.ignorecase = True: re.Pattern = "\b((\w+)\s+)(?:\2\b)+"
If re.test(s) Then Set ms = re.Execute(s): _
DelDouble = Left(s, ms(0).firstindex) & Right(s, Len(s) - ms(0).firstindex - Len(ms(0).submatches(0)))
End Function