Excel：查找范围内文本字符串的所有实例并返回每个实例

Question

我需要找到可能出现在一列中的特定标识符的所有实例，并将它们连接成一个字符串。

标识符将以"ECP" 开头，用破折号或空格分隔，分隔符后有多个字符。例如。 "ECP 05-00012A1, "ECP-123456."

我使用了下面的公式，但没有想到多个“ECP 编号”。

=INDEX('Raw WAM Data'!$A$1:$A$10000,MATCH(VLOOKUP("*"&"ECP"&"*",'Raw WAM Data'!$A$1:$A$10000,1,FALSE),'Raw WAM Data'!$A$1:$A$10000,0))

然后我使用=LEFT($C$62,FIND(" ", $C$62, FIND(" ", $C$62)+1)) 解析相邻单元格中的数据 然后将该字符串加载到用户窗体文本框中。

然后我需要将所有返回的值连接成一个用逗号分隔的字符串，以便它可以加载到用户窗体文本框。

我认为 VBA 非常适合此问题，但我愿意接受任何建议。

Answer 1

如果我对你想要达到的目标有正确的理解，那么你可以使用这样的东西：

Sub TEST()
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim cl As Range, x&
    With Sheets("Sheet1") 'replace sheet1 by name of your sheet
        x = .Cells(Rows.Count, "A").End(xlUp).Row
        For Each cl In .Range(.[A1], .Cells(x, "A"))
            If UCase(cl.Value2) Like "ECP*" And Not dic.exists(cl.Value2) Then
                dic.Add cl.Value2, Nothing
            End If
        Next cl
    End With
    Debug.Print Join(dic.keys, Chr(10))
End Sub

测试

---

更新

相对于在其中找到结果的单元格，将结果放在 E 列中的最佳方法是什么？另外，如果我想搜索多个列，我应该如何调整代码？

你可以这样使用：

Sub TEST2()
    Dim cl As Range, x&
    With Sheets("Sheet1") 'replace sheet1 by name of your sheet
        x = .[A:C].Find("*", , , , xlByRows, xlPrevious).Row 'get the last used row in range
        For Each cl In .Range(.[A1], .Cells(x, "C"))
            If UCase(cl.Value2) Like "*ECP*" Then
                If .Cells(cl.Row, "E").Value2 = "" Then
                    .Cells(cl.Row, "E").Value2 = cl.Value2
                Else
                    .Cells(cl.Row, "E").Value2 = .Cells(cl.Row, "E").Value2 & "; " & cl.Value2
                End If
            End If
        Next cl
    End With
End Sub

输出

Answer 2

如果您的值在工作表的 A 列中，此例程将收集您的 ECP 编号并将它们加载到数组中。然后，您可以将数组加载到您的 TextBox 中。

Sub GatherECPs()

Dim ECParr

'Loop down each row starting at row 2 (assuming you have headers)
For x = 2 To SourceSheet.Range("A2").End(xlDown).Row
    'Check if the start of the string is ECP
    If Left(SourceSheet.Cells(x, 1).Value, 3) = "ECP" Then
        'Add a row to the array
        If IsEmpty(ECParr) Then
            ReDim ECParr(0)
        Else
            ReDim Preserve ECParr(UBound(ECParr) + 1)
        End If
        'Add the value to the array
        ECParr(UBound(ECParr)) = Right(SourceSheet.Cells(x, 1).Value, Len(SourceSheet.Cells(x, 1).Value) - 4)
    End If
Next

End Sub

将 SourceSheet 替换为您的值所在的工作表。

Answer 3

要以一种也适用于一个单元格中的多个“ECP”的快速方式执行此操作，只需使用此功能：

Public Function getStr(rng As Range, ident As String) As String
  Dim i As Long, x As Variant, y As Variant
  For Each x In Intersect(rng, rng.Parent.UsedRange).Value
    y = Split(x, ident)
    If UBound(y) > 0 Then
      For i = 1 To UBound(y)
        getStr = getStr & ", " & ident & Split(y(i), ",")(0)
      Next
    End If
  Next
  getStr = Mid(getStr, 3)
End Function

它将返回一个逗号分隔的字符串。像这样使用它：getStr(Range("A:A"), "ECP")

如果你还有任何问题，尽管问;)