VBA разбивает ячейку по новой строке в цикле

Question

Новичок в VBA, пытается создать функцию, которая по существу ищет столбец для определенных значений.Если он находит попадание, он возвращает соответствующий столбец, иначе возвращает пробел.При способе форматирования листа одна ячейка может иметь несколько значений (разделенных ALT + ENTER, поэтому каждое новое значение находится на отдельной строке).

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

Example:
**Column to Search (one cell)**
ABC
AB
B

Когда я запускаю код, чтобы найти AB, он будет возвращать совпадения как для AB, так и для ABC, так как AB является частьюэтого

Идеальным решением было бы сначала разделить ячейки на основе ALT + ENTER и выполнить цикл по всем значениям на ячейку, а затем вернуть желаемое значение.Но не так, как будет выглядеть синтаксис.

Текущий код

Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim result As String
Dim mRange As Range
Dim mValue As String

For i = 1 To Search_in_col.Count

    If InStr(1, Search_in_col.Cells(i, 1).Text, Search_string) <> 0 Then
          If (Return_val_col.Cells(i, 1).MergeCells) Then

            Set mRange = Return_val_col.Cells(i, 1).MergeArea
            mValue = mRange.Cells(1).Value

            result = result & mValue & ", "
        Else
            result = result & Return_val_col.Cells(i, 1).Value & ", "
        End If
    End If

Next 

Пример: добавление примера для лучшего объяснения ситуации

Answer 1

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

Option Explicit
'Set reference to Microsoft VBScript Regular Expressions 5.5
Function col_return(lookFor As String, lookIn As Range) As String
    Dim RE As RegExp
    Dim C As Range
    Dim S As String

Set RE = New RegExp
With RE
    .Global = True
    .IgnoreCase = True 'unless you want case sensitive searches
    For Each C In lookIn
        .Pattern = "\b(" & lookFor & ")\b"
        If .Test(C.Text) = True Then
            S = S & "," & C.Offset(0, -1)
        End If
    Next C
End With

col_return = Mid(S, 2)

End Function

Я использовал раннее связывание, что означает, что вы устанавливаете ссылку в VBA, как отмечено в комментариях.

Вы можете использовать поздноОбязательный и избегайте ссылки.Для этого вы должны изменить на DIM и установить для RE строки:

DIM RE as Object

Set RE = createobject("vbscript.regexp")

Вы можете узнать о раннем или позднем связывании, выполнив поиск в Интернете.

Формула, которую я использовали макет на скриншоте ниже:

Answer 2

Вы можете разделить строку и цикл, который.

Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String


    If Search_in_col.Cells.Count <> Return_val_col.Cells.Count Then Exit Function

    Dim sptStr() As String
    sptStr = Split(Search_string, Chr(10))

    Dim srchArr() As Variant
    srchArr = Search_in_col.Value

    Dim RetArr() As Variant
    RetArr = Return_val_col.Value

    Dim i As Long
    For i = LBound(sptStr) To UBound(sptStr)
        Dim j As Long
        For j = LBound(srchArr, 1) To UBound(srchArr, 1)
            If srchArr(j, 1) = sptStr(i) Then
                newFunc = newFunc & RetArr(j, 1) & ", "
            End If
        Next j
    Next i

    newFunc = Left(newFunc, Len(newFunc) - 2)


End Function

---

РЕДАКТИРОВАТЬ:

Согласноновая информация:

Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String

    Search_string = "|" & Search_string & "|"

    Dim srchArr() As Variant
    srchArr = Search_in_col.Value

    Dim RetArr() As Variant
    RetArr = Return_val_col.Value

    Dim i As Long
    For i = LBound(srchArr, 1) To UBound(srchArr, 1)
        Dim T As String
        T = "|" & Replace(srchArr(i, 1), Chr(10), "|") & "|"

        If InStr(T, Search_string) > 0 Then
              newFunc = newFunc & RetArr(i, 1) & ", "
        End If

    Next i

    newFunc = Left(newFunc, Len(newFunc) - 2)
End Function