Удалите слова, которые содержат друг друга, и оставьте длинный

Я ищу макрос (желательно функцию), который будет принимать содержимое ячеек, разделить его на отдельные слова, сравнить их друг с другом и удалить более короткие слова.

Вот изображение того, что я хочу, чтобы результат выглядел (мне нужны вычеркнутые слова):

пример

Я сам пытался написать макрос, но он не работает на 100%, потому что он не принимает последние слова и иногда удаляет то, что не следует удалять. Кроме того, я должен сделать это примерно на 50k ячеек, поэтому макрос занимает много времени, поэтому я бы предпочел, чтобы это была функция. Я думаю, я не должен использовать функцию replace , но я не мог заставить ничего работать.

 Sub clean_words_containing_eachother() Dim sht1 As Worksheet Dim LastRow As Long Dim Cell As Range Dim cell_value As String Dim word, word2 As Variant Set sht1 = ActiveSheet col = InputBox("Which column do you want to clear?") LastRow = sht1.Cells(sht1.Rows.Count, col).End(xlUp).Row Let to_clean = col & "2:" & col & LastRow For i = 2 To LastRow For Each Cell In sht1.Range(to_clean) cell_value = Cell.Value cell_split = Split(cell_value, " ") For Each word In cell_split For Each word2 In cell_split If word <> word2 Then If InStr(word2, word) > 0 Then If Len(word) < Len(word2) Then word = word & " " Cell = Replace(Cell, word, " ") ElseIf Len(word) > Len(word2) Then word2 = word2 & " " Cell = Replace(Cell, word2, " ") End If End If End If Next word2 Next word Next Cell Next i End Sub 

Предполагая, что сохранение третьего слова в вашем первом примере является ошибкой, поскольку книги в дальнейшем содержатся в записных книжках :

 5003886 book books bound case casebound not notebook notebooks office oxford sign signature 

а также предполагая, что вы захотите удалить повторяющиеся одинаковые слова, даже если они не будут содержаться впоследствии в другом слове, тогда мы можем использовать регулярное выражение.

Регулярное выражение будет:

  • Захват каждого слова
  • посмотрите, будет ли это слово существовать позже в строке
    • если это произойдет, удалите его

Поскольку регулярные выражения VBA также не могут смотреть назад, мы обходим это ограничение, повторяя регулярное выражение во второй раз по инвертированной строке.

Затем удалите лишние пробелы, и мы закончили.

 Option Explicit Function cleanWords(S As String) As String Dim RE As Object, MC As Object, M As Object Dim sTemp As String Set RE = CreateObject("vbscript.regexp") With RE .Global = True .Pattern = "\b(\w+)\b(?=.*\1)" .ignorecase = True 'replace looking forward sTemp = .Replace(S, "") ' check in reverse sTemp = .Replace(StrReverse(sTemp), "") 'return to normal sTemp = StrReverse(sTemp) 'Remove extraneous spaces cleanWords = WorksheetFunction.Trim(sTemp) End With End Function 

Ограничения

  • пунктуация не будет удалена
  • «слово» определяется как содержащее только символы в классе [_A-Za-z0-9] (буквы, цифры и подчеркивание).
  • если любые слова могут быть переносимыми или содержать другие символы, отличные от слов
    • в вышесказанном, они будут рассматриваться как два отдельных слова
    • если вы хотите, чтобы это рассматривалось как одно слово, тогда нам может потребоваться изменить регулярное выражение

Общие шаги:

  • Запись ячейки в массив (уже работает)
  • для каждого элемента ( x ), пройдите через каждый элемент ( y ) (уже работающий)
  • если x находится в y AND y больше, чем x THEN, установите x на ""
  • concat array обратно в строку
  • написать строку в ячейку

Операции с строками / массивами намного быстрее, чем операции с ячейками, поэтому это даст вам некоторое увеличение производительности (в зависимости от количества слов, которое нужно заменить для каждой ячейки).

«Последняя проблема слов» может заключаться в том, что у вас нет места после последнего слова в ваших ячейках, поскольку вы заменяете word + " " на " " .

  • Проблема с функцией CDate в VBA
  • Как использовать постоянные значения в Excel UDF?
  • Excel вычисляет формулу с функцией VBA как ошибку, если она не была повторно введена
  • Функция, определяемая пользователем Excel, если ячейка подсвечена, тогда
  • Как я могу извлечь конкретные буквы и цифры из текстовой строки через VBA или excel Formula
  • Автоматически показывать, какие переменные необходимы при использовании публичной функции vba в excel
  • Возврат определенного типа данных в ячейке Excel
  • Давайте будем гением компьютера.