从一系列单元格中提取多个字符串答案

【问题标题】：Extracting several strings from a range of cells从一系列单元格中提取多个字符串
【发布时间】：2015-04-29 15:00:18
【问题描述】：

我有几千个单元格，我需要从中提取文档编号。单元格没有任何格式，但每个文档编号都以“Doc#-”开头比如

B2：

This is an example cell showing a doc number DOC#-12351-2432-1b and a second document DOC#-2342-RTF-DD-09, there may be several more or only one.

我正在寻找一种将所有文档编号提取为单独编号的方法，将其提取到单独的单元格、行等中。最好的方法是什么？

目前我有一些非常粗略的公式。

=MID($B2,find("DOC#-",$b2,1),FIND(" ",$b2,find("DOC#-",$b2,1))-find("Doc#-",$b2,1)

Which：查找第一个文档，在其后找到一个空格，返回带有 MID 的数字。

认为 VBA 可能是解决此问题的方法，但我不知道如何解决。

【问题讨论】：

只是一个想法，但也许（因为似乎没有真正一致的 DOC 编号格式）突出显示单元格并使用带有空格分隔符的文本到列。从您的示例中至少可以提取它们。
很想这样做，因为这会让它变得超级简单。但是，您不能在 Text-to-cols 中为分隔符输入多个字符，并且“#”和“-”太多，我无法可靠地单独使用它们。
哦！找到“DOC#-”，替换“@DOC#-”。现在我可以 Text to Col。然后是一些公式来删除尾随文本。猜猜谢谢 Mrbungle
我使用了您的示例并使用了空格分隔符，并将“DOC#-12351-2432-1b”和“DOC#-2342-RTF-DD-09”提取到单独的单元格中。从那里你至少可以用它做点什么。
好了，没问题:)

标签： regex excel excel-formula vba

【解决方案1】：

选择您要处理的单元格并运行这个小宏：

Sub qwerty()
    Dim i As Long, V As String, K As Long
    For Each r In Selection
        V = Replace(r.Value, ",", " ")
        ary = Split(V, "DOC#-")
        K = 1
        For i = 1 To UBound(ary)
            bry = Split(ary(i), " ")
            bry(0) = "DOC#-" & bry(0)
            r.Offset(0, K).Value = bry(0)
            K = K + 1
        Next i
    Next r
End Sub

它将寻找空格或逗号来终止文档编号。这是输入/输出的示例：

【讨论】：

无论如何都要保留这个。步骤少。谢谢。
很好的答案，虽然很想看到基于数组公式的答案。
@zx8754 对我来说，构造公式比编写 VBA 困难得多。
@Gary'sStudent 对我来说正好相反 :)

【解决方案2】：

提高速度的变体数组/正则表达式方法

Sub GetDoc()
Dim X
Dim objRegex As Object
Dim objRegexMC As Object
Dim objRegexM As Object
Dim lngCnt As Long
Dim lngCnt2 As Long

X = Range([a1], Cells(Rows.Count, "A").End(xlUp))
ReDim Preserve X(1 To UBound(X, 1), 1 To 100)

Set objRegex = CreateObject("vbscript.regexp")
With objRegex
    .Global = True
    .ignorecase = True
    .Pattern = "DOC#[-\w]+"
For lngCnt = 1 To UBound(X)
    If .test(X(lngCnt, 1)) Then
    lngCnt2 = 2
        Set objRegexMC = .Execute(X(lngCnt, 1))
            For Each objRegexM In objRegexMC
                X(lngCnt, lngCnt2) = objRegexM
            lngCnt2 = lngCnt2 + 1
            Next
    End If
Next
End With

[a1].Resize(UBound(X, 1), UBound(X, 2)) = X

End Sub

【讨论】：