excel - 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 

示例：添加示例以更好地说明情况

标签： excelvba

Answer 1

您可以拆分字符串并循环。

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