Question

VBA的新增功能，试图创建一个实质上在列中搜索某些值的函数。如果找到匹配项，则返回相应的列，否则返回空格。工作表的格式设置方式是，一个单元格可以具有多个值（用ALT + ENTER分隔，因此每个新值都在单独的行上）。

我使用的代码当前有效，但存在问题：由于我使用的是inStr，因此代码也会返回部分匹配项（我不希望这样做）。

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

当我运行代码以找到AB时，由于AB是AB的一部分，它将返回AB和ABC的匹配。

理想的解决方案是先根据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

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

docs

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

Answer 2

您可以使用具有单词边界标记的正则表达式。以下内容似乎重现了示例中显示的内容：

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")

您可以通过互联网搜索来了解早期绑定与后期绑定。

我使用的公式和布局在下面的屏幕截图中：

VBA通过循环中的新行拆分单元格

2 个答案: