Excel-VBA Подсчет переменных подстрок в строке

Question

Я использую Excel VBA для проверки точности строки. Мне нужно убедиться, что переменная подстрока не дублируется. Я использовал громоздкий метод ElseIf, но в нем отсутствуют случаи, когда использовалось более одной подстроки. Первая подстрока прошла, но она не зацикливается, чтобы проверить следующую подстроку.

Dim chkstring As String, phrase As String

If InStr(chkstring, "BAG") > 0 Then
        phrase = "BAG"
    ElseIf InStr(chkstring, "NOTE") > 0 Then
        phrase = "NOTE"
    ElseIf InStr(chkstring, "MEMO") > 0 Then
        phrase = "MEMO"
Else
        phrase = ""
    End If
If phrase <> "" Then
        OccurCount = findOccurancesCount(chkstring, phrase)
        If OccurCount > 1 Then
            'highlight cell
        End If
    End If

Затем я использую

Function findOccurancesCount(chkstring, phrase)
        OccurCount = 0
        y = 1
    Do
    foundPosition = InStr(y, chkstring, phrase) 'searching from i position
    If foundPosition > 0 Then                       'substring is found at foundPosition index
        OccurCount = OccurCount + 1       'count this occurance
        y = foundPosition + 1                       'searching from x+1 on the next cycle
    End If
    Loop While foundPosition <> 0
findOccurancesCount = OccurCount

End Function

Это нормально, если chkstring = "BAG BAG"Но если есть более одной фразы, он не вернется, чтобы искать других. Например: «BAG NOTE NOTE»

«BAG» проходит проверку, но не возвращается к поиску «NOTE».

Мне интересно, есть ли более эффективный способ объединить все возможные фразы, а затем проверить, нет ли среди них в chkstring более одной? Спасибо!

Answer 1

Для подсчета количества вхождений фразы в chkstring вы можете использовать эту функцию

Function findOccurancesCount(chkstring, phrase)
    findOccurancesCount = (Len(chkstring) - Len(Replace(chkstring, phrase, ""))) / Len(phrase)
End Function

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

Sub test(chkstring as String)
    If findOccurancesCount(chkstring, "BAG") > 1 _
        Or findOccurancesCount(chkstring, "NOTE") > 1 _
        Or findOccurancesCount(chkstring, "MEMO") > 1 _
        Then
        'highlight cell
        Debug.Print "highlight cell"
    End If
End Sub

Answer 2

Вот функция, которая использует регулярные выражения, чтобы увидеть, встречается ли какое-либо слово в строке более одного раза.

Если повторяющихся слов нет -> TRUE, иначе FALSE

Option Explicit
Function noDups(s As String) As Boolean
    Dim RE As Object
    Const sPat As String = "(\b\w+\b)(?=.*\1)"

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .Pattern = sPat
    noDups = Not .test(s)
End With

End Function

Если вы ищете только несколько ключевых слов, которые НЕ должны дублироваться, измените шаблон:

eg:  sPat = "(\b(?:bag|note|memo)\b)(?=.*\1)"

Answer 3

Попробуйте эту функцию, если вам нужно что-то похожее на то, что у вас уже есть

Function findOccurancesCount(chkstring, phrase)
 Dim residualString As String
 Dim OccurCount As Integer

 OccurCount = 0
 residualString = chkstring

 Do

    foundPosition = InStr(1, residualString, phrase)                            'search phrase in residualString
    If foundPosition > 0 Then                                                   'substring is found at foundPosition index
        OccurCount = OccurCount + 1                                             'count this occurance
        residualString = Replace(residualString, phrase, "", foundPosition, 1)  'remove found phrase from residualString
    End If
 Loop While foundPosition <> 0                                                   'loop until no phrase is found

 findOccurancesCount = OccurCount

End Function