Страницы: 1
RSS
Удалить слова из ячеек по списку
 
Есть столбик с ячейками 20000 строк. Из ячеек надо удалить слова, содержащиеся в списке стоп слов. Слов в списке стоп слов около 5000

Пример:
Из ячейки "Старлайн с автозапуском А93" нужно будет удалить слова, содержащиеся в списке стоп слов
"старлайн",
"с",
"автозапуском"

И в результате останется "А93"
 
см. файл

P.S. У вас ещё "eco" в списке минус слов, а в конечном варианте у вас eco остались )
Изменено: New - 06.08.2020 15:37:31
 
Круто. Работает!
А с большими данными тоже будет работать?
 
Можно ещё так
 
Работает!
Спасибо вам!
 
New, там ещё application.trim() нужно навесить на результат.
 
Игорь, да, но я не стал. В образце от ТС готового результата были с пробелами, я так и оставил
Хотя в моем коде некуда вешать Application.Trim(), т.к. я не массив итоговых данных обрабатываю, а просто обычной заменой убираю ненужные слова.
Это если брать все данные в массив и в массиве удалять ненужные слова, там можно применить Trim, а потом выгрузить итоговый результат на лист.

Вот код, куда тут вешать Trim() ?

Код
Sub DeleteWords()
Dim arrDeleteWords, i As Long

    Application.ScreenUpdating = False
    arrDeleteWords = Worksheets("Список минус слов").Range("A1").CurrentRegion
    With Worksheets("Исходные данные")
        For i = 1 To UBound(arrDeleteWords)
            .Columns(1).Replace What:=arrDeleteWords(i, 1), Replacement:="", LookAt:=xlPart
        Next i
    End With
    Application.ScreenUpdating = True
    MsgBox "Удаление слов завершено!", vbInformation, ""
End Sub

Вот тут можно сделать Trim(), но мне кажется, что первый вариант будет быстрее на 5000 строках, чем этот

Код
Sub DeleteWords()
Dim arrDeleteWords, arrDirtyList, i As Long, n As Long
    Application.ScreenUpdating = False
    arrDeleteWords = Worksheets("Список минус слов").Range("A1").CurrentRegion
    arrDirtyList = Worksheets("Исходные данные").Range("A1").CurrentRegion
    For i = 2 To UBound(arrDirtyList, 1)
        For n = 2 To UBound(arrDeleteWords)
                If InStr(1, arrDirtyList(i, 1), arrDeleteWords(n, 1), vbTextCompare) > 0 Then
                    arrDirtyList(i, 1) = Replace(arrDirtyList(i, 1), arrDeleteWords(n, 1), "")
                End If
        Next n
        arrDirtyList(i, 1) = Application.Trim(arrDirtyList(i, 1))
    Next i
    Worksheets("Исходные данные").Range("A1").Resize(UBound(arrDirtyList, 1), UBound(arrDirtyList, 2)).Value = arrDirtyList
    Application.ScreenUpdating = True
    MsgBox "Удаление слов завершено!", vbInformation, ""
End Sub
Изменено: New - 06.08.2020 21:37:45
Страницы: 1
Наверх