excel - 在字符串 VBA 中搜索数字

Question

我正在尝试在字符串中的连续位置(至少 3 个)中搜索数字类型字符。例如，如果我有这个字符串:

“lorem ippsum dolor坐着，共同宣传Elit。 ullamcorper eget idtortor。CrasVehicula Malesuada luctus。例如 Fusce luctus enim eff 43 icitur aliquet finibus。Nam ac 1 发酵液。

我希望我的 VBA 脚本返回这个:

1844763
243
46626

这是我目前正在使用的脚本:

                start = 1
                Do
                    If IsNumeric(Mid(Sheets("Sheet1").Cells(x, 1), start, 1)) Then
                        If start = Len(Sheets("Sheet1").Cells(x, 1)) Then
                            Exit Do
                        End If
                        If IsNumeric(Mid(Sheets("Sheet1").Cells(x, 1), start + 1, 1)) Then
                            If start + 1 = Len(Sheets("Sheet1").Cells(x, 1)) Then
                                Exit Do
                            End If
                            If IsNumeric(Mid(Sheets("Sheet1").Cells(x, 1), start + 2, 1)) Then
                                Sheets("Sheet1").Cells(x, 2).Interior.Color = RGB(255, 0, 0)
                                Sheets("Sheet1").Cells(x, 2) = Sheets("Sheet1").Cells(x, 2) & Mid(Sheets("Sheet1").Cells(x, 1), start, 3)
                                start = start + 3
                                While IsNumeric(Mid(Sheets("Sheet1").Cells(x, 1), start, 1))
                                    Sheets("Sheet1").Cells(x, 2) = Sheets("Sheet1").Cells(x, 2) & Mid(Sheets("Sheet1").Cells(x, 1), start, 1)
                                    start = start + 1
                                Wend
                                Sheets("Sheet1").Cells(x, 2) = Sheets("Sheet1").Cells(x, 2) & vbCrLf
                            End If
                        End If
                    End If
                   If Not IsNumeric(Mid(Sheets("Sheet1").Cells(x, 1), start, 1)) Then
                        start = start + 1
                    End If
                Loop While inicio < Len(Sheets("Comments").Cells(x, 1))

该脚本适用于小字符串(10-20 个字符)。处理像上面这样的字符串时事情会变得一团糟(我的电脑速度明显变慢，excel永远没有响应)。您对如何优化此代码有任何想法吗？

谢谢!

Answer 1

这是一个正则表达式解决方案。输出放在单独的单元格中，但可以作为字符串等返回。也许将其转换为 UDF？

Sub Regex2()

Dim oMatches As Object, i As Long, vOut

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\d{3,}"
    If .Test(Range("A1")) Then
        Set oMatches = .Execute(Range("A1"))
        ReDim vOut(0 To oMatches.Count - 1)
        For i = 0 To oMatches.Count - 1
            vOut(i) = oMatches(i).Value
        Next i
        Range("B1").Resize(i) = WorksheetFunction.Transpose(vOut)
    End If
End With

End Sub