Подсчитайте повторяющиеся слова в строке и удалите, если они встречаются менее 10 раз
Я новичок в VBA и написал код для удаления повторяющихся слов в строке. Однако я хотел бы иметь возможность подсчитывать появление слов в строке, и если оно встречается менее 10 раз, я хочу удалить это слово.
Это мой код:
Function RemoveDupeWords(text As String, Optional delimiter As String = " ") As String
Dim dictionary As Object
Dim i, part
Set dictionary = CreateObject("Scripting.Dictionary")
dictionary.comparemode = vbTextCompare
For Each i In Split(text, delimiter)
part = Trim(i)
If part <> "" And Not dictionary.Exists(part) Then
dictionary.Add part, Nothing
End If
Next
If dictionary.Count > 0 Then
RemoveDupeWords = Join(dictionary.keys, delimiter)
Else
RemoveDupeWords = ""
End If
Set dictionary = Nothing
End Function
Как я могу это сделать?
Я особо ничего не пробовал, потому что не знаю с чего начать
Ответы 3
Вместо того, чтобы устанавливать значение словаря на Nothing, используйте его для хранения количества и увеличения по мере того, как вы находите больше одного и того же слова:
For Each i In Split(text, delimiter)
part = Trim(i)
If part <> "" Then
'if it IS NOT in the dictionary, add it.
If Not dictionary.Exists(part) Then
dictionary.Add part, 1
'if it IS in the dictionary, increment the value
Else
dictionary(part) = dictionary(part) + 1
End If
End If
Next
Теперь, когда у вас есть подсчет для каждого непустого термина, вы можете перебрать словарь и удалить все, что соответствует вашим критериям:
For Each dictKey in dictionary.keys()
if dictionary(dictKey) < 10 Then
dictionary.remove(dictKey)
End If
Next dictKey
Обратите внимание, что я не проверял это, и прошло много времени с тех пор, как я написал VBA, но я считаю, что синтаксис правильный.
Обновлять:
Я подключился к ноутбуку с Windows, быстро запустил его и добился успеха:
Вы можете видеть, что только слова a и test проходят через словарь, как и ожидалось.
Код, используемый в тесте:
Dim dictionary As Object
Dim i, part
Set dictionary = CreateObject("Scripting.Dictionary")
dictionary.comparemode = vbTextCompare
For Each i In Split("this is is is is is a a a a a a a a a a a a a a test test test test test test test test test test test test of of this funcitonality", " ")
part = Trim(i)
If part <> "" Then
'if it IS NOT in the dictionary, add it.
If Not dictionary.Exists(part) Then
dictionary.Add part, 1
'if it IS in the dictionary, increment the value
Else
dictionary(part) = dictionary(part) + 1
End If
End If
Next
For Each dictKey In dictionary.keys()
If dictionary(dictKey) < 10 Then
dictionary.Remove (dictKey)
End If
Next dictKey
это не работает. Ничего не удаляется
У вас было 2 синтаксических ошибки - я их исправил
@FunThomas Спасибо! Я использую Mac прямо сейчас, и, хотя VBA поддерживается, VBE настолько медленный, что у меня просто не хватает терпения, чтобы проверить эти вещи.
@user21226398 user21226398 Я только что запустил на машине с Windows и добился успеха. Я добавил к ответу, чтобы показать, как это работает, на рабочем примере.
@JNevil: Scripting.Dictionary вообще не работает на Mac, поскольку это объект Windows, а не VBA
Ой! Я рад, что не пытался на своем Mac. Я все равно отказываюсь использовать VBA для этого. У меня просто не хватает на это терпения.
@JNevil Спасибо, мне просто нужно было кое-что изменить, чтобы это работало в моем коде. Но я заставил его работать. Большое спасибо!!
Трудно ответить на этот вопрос без примерных данных. Я мог только представить, что вы захотите утверждать, что подстроки, которые вы хотите сохранить, остаются в исходном положении. Вы можете создать функцию, но если вы готовы использовать ms365, попробуйте:
Формула в C1:
=LET(del," ",MAP(A1:A4,LAMBDA(x,LET(y,TEXTSPLIT(x,del),TEXTJOIN(del,,MAP(y,LAMBDA(z,IF(SUM(--(y=z))>9,z,""))))))))
Я не возражаю, если они не в исходном положении. Также я буду вычислять некоторые другие преобразования в этой строке, поэтому я хотел бы, чтобы код был в VBA.
Спасибо за ответ. Возможно, VBA действительно ваш выбор, просто знайте, что функции ms365, возможно, более мощные, чем вы думаете. В зависимости от этих преобразований нативные функции могут работать нормально. По крайней мере, знать, что есть возможность. Кроме того, пожалуйста, убедитесь, что это не будет xy-проблемой =) @user21226398
Если вы хотите подсчитать, сколько раз подстрока встречается в строке, вы можете использовать функцию ниже
Public Function Count(byref ipHost as string, byref ipFind as string)
Count = (len(iphost) - len(Replace(ipHost,ipFind,vbnullstring)))/len(ipFind)
end function
У вас есть какие-то образцы данных, чтобы пойти с этим? Наряду с некоторыми желаемыми результатами?