Циклическое сопоставление слов в Excel VBA - PullRequest
2 голосов
/ 30 марта 2012

У меня есть список ключевых слов, и я хочу посмотреть, содержит ли одна ячейка какое-либо из этих слов. Например, если мой список ключевых слов (Cat, Dog, Turtle), функция вернула бы MATCH, если бы она искала «Mr. Dogs Magic Land». Я нашел хороший UDF онлайн для использования в качестве функции, но когда я пытаюсь зациклить его, чтобы он проверял каждое слово в моем списке ключевых слов, я получал #VALUE !. Первая функция - это мой цикл, а вторая - функция поиска UDF, найденная в интернете (извините, не помню, где, кроме того, кто делает это.) 1001 *

Function StringFind(rng(), source)
For I = LBound(rng) To UBound(rng)
StringFind = MyMatch(rng(I), source)
If StringFind = "MATCH" Then Exit Function
Next I
StringFind = "NO MATCH"
End Function  

Function MyMatch(FindText As String, WithinText As Variant) As String
     '
    Dim vntFind As Variant
    Dim vntWithin As Variant

    For Each vntFind In Split(UCase(FindText), " ")
        If Len(Trim(vntFind)) > 0 Then
            For Each vntWithin In Split(UCase(WithinText), " ")
                If Len(Trim(vntWithin)) > 0 Then
                    If vntFind = vntWithin Then
                        MyMatch = "MATCH"
                        Exit Function
                    End If
                End If
            Next
        End If
    Next
    MyMatch = "NO MATCH"
End Function

Ответы [ 2 ]

3 голосов
/ 30 марта 2012

1) ФОРМУЛА

Сначала я бы предложил решение, отличное от VBA, для этой конкретной проблемы, поскольку VBA на самом деле не нужна.Эта массив формула будет делать то же самое.Введите массив, нажав CTRL-SHIFT-ENTER, и вы увидите фигурные скобки {}, появившиеся вокруг вашей формулы.Затем вы можете скопировать вниз.

'= IF (ИЛИ (ISNUMBER (ПОИСК ($ F $ 1: $ F $ 3, A1))), «Совпадение», «Без совпадения»)

2) UDF

Используя тот же синтаксис, что и у вас, вот как я могу подойти к этому с UDF.

enter image description here

Function MySearch(MyRNG As Range, MyStr As String) As String
Dim cell As Range

    For Each cell In MyRNG
        If LCase(MyStr) Like LCase("*" & cell & "*") Then
            MySearch = "Match"
            Exit Function
        End If
    Next cell

    MySearch = "No Match"
End Function
0 голосов
/ 30 марта 2012

Подключил это как есть в моем VBE, и я даже не смог скомпилировать.

Эта строка

StringFind = MyMatch(rng(I), source)

необходимо изменить на

StringFind = MyMatch(rng(I).Value, source)

чтобы даже заставить его работать на меня. Это МОЖЕТ стать причиной вашей проблемы.


EDIT

Хорошо, я рассмотрел все более подробно. Похоже, это будет работать для вас. (Извините, я не хотел просто сделать все это для вас, но вот оно.) Вероятно, нужно еще немного настроить, чтобы это работало для ваших нужд.

Проблема заключалась в том, что вы искали неопределенные типы данных (добавлен / изменен вызов основной функции на As String и As Range). Хотя неопределенные типы могут работать, я думаю, что было сложно понять, почему возникла проблема. Я пытался установить точку останова в функции и даже не зашел так далеко, потому что передавался неправильный тип данных. Лично я всегда использую Option Explicit, чтобы предотвратить подобные проблемы в моем собственном коде.

Приведенный ниже код будет искать значение в первом аргументе (Search, может быть "" текст / String или отдельную ячейку / Range) для всех значений во втором аргументе (Source a Range (состоит из одной или нескольких ячеек).

Public Function StringFind(Search As String, Source As Range)
Dim rngCell As Range
For Each rngCell In Source.Cells
StringFind = MyMatch(Search, rngCell.Value)
If StringFind = "MATCH" Then Exit Function
Next rngCell
StringFind = "NO MATCH"
End Function

Function MyMatch(FindText As String, WithinText As Variant) As String
     '
    Dim vntFind As Variant

    For Each vntFind In Split(UCase(FindText), " ")
        If Len(Trim(vntFind)) > 0 Then
            If vntFind = Trim(UCase(WithinText)) Then
                MyMatch = "MATCH"
                Exit Function
            End If
        End If
    Next
    MyMatch = "NO MATCH"
End Function
...