Excel 在字符串VBA中搜索数字
我正在尝试搜索字符串中至少3个连续位置的数字类型字符。例如，如果我有以下字符串： Lorem ipsum dolor sit amet，是一位杰出的献身者。酒后驾车，无路可走，无路可走，无路可走，无路可走，无路可走。Morbi lobortis ligula tincidunt 1844763，马萨维尔accumsan，Placelat libero。在leo lacinia 243 ullamcorper eget id tortor的nisl中。马利苏达-卢库斯车辆。在布朗迪特的非阿库。不要用同样的方法来解决问题。纳拉46626 laoreet viverra purus fringilla pellentesque。莫里斯坐在拉库斯显贵酒店的艾米特·普尔文纳·维利特（amet pulvinar velit）的座位上。不含溶剂的化学制剂，如Fusce luctus enim Efficitur aliquet finibus。Nam ac 1 Fermentum lacus 我希望我的VBA脚本返回以下内容： 1844763 243 46626 这是我目前正在使用的脚本：Excel 在字符串VBA中搜索数字,excel,vba,search,Excel,Vba,Search,我正在尝试搜索字符串中至少3个连续位置的数字类型字符。例如，如果我有以下字符串： Lorem ipsum dolor sit amet，是一位杰出的献身者。酒后驾车，无路可走，无路可走，无路可走，无路可走，无路可走。Morbi lobortis ligula tincidunt 1844763，马萨维尔accumsan，Placelat libero。在leo lacinia 243 ullamcorper eget id tortor的nisl中。马利苏达-卢库斯车辆。在布朗迪特的非阿库。不要
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))
谢谢大家! 下面是一个正则表达式解决方案。输出放在单独的单元格中，但可以作为字符串等返回。是否可以将其转换为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
下面是一个正则表达式解决方案。输出放在单独的单元格中，但可以作为字符串等返回。是否可以将其转换为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
Option Explicit
Sub test()
Dim arr As Variant
Dim i As Long, y As Long, Counter As Long
Dim str As String
str = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nulla purus dui, lobortis non 54leo non, feugiat venenatis urna." & _
"Morbi lobortis ligula tincidunt 1844763, accumsan massa vel, placerat libero. In a nisl in leo lacinia 243 ullamcorper eget id tortor." & _
"Cras vehicula malesuada luctus. Donec egestas non arcu in blandit. Donec eu lacinia ipsum, et consequat mi." & _
"Nulla 46626 laoreet viverra purus fringilla pellentesque. Mauris sit amet pulvinar velit, at dignissim lacus." & _
"Maecenas non sollicitudin ex. Fusce luctus enim eff43icitur aliquet finibus. Nam ac 1fermentum lacus."
arr = Split(str, " ")
For i = LBound(arr) To UBound(arr)
Counter = 0
For y = 1 To Len(Trim(arr(i)))
If IsNumeric(Mid(Trim(arr(i)), y, 1)) Then
Counter = Counter + 1
End If
If Counter >= 3 Then
Debug.Print Replace(Trim(arr(i)), ",", "")
Exit For
End If
Next y
Next i
End Sub
Option Explicit
Sub test()
Dim arr As Variant
Dim i As Long, y As Long, Counter As Long
Dim str As String
str = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nulla purus dui, lobortis non 54leo non, feugiat venenatis urna." & _
"Morbi lobortis ligula tincidunt 1844763, accumsan massa vel, placerat libero. In a nisl in leo lacinia 243 ullamcorper eget id tortor." & _
"Cras vehicula malesuada luctus. Donec egestas non arcu in blandit. Donec eu lacinia ipsum, et consequat mi." & _
"Nulla 46626 laoreet viverra purus fringilla pellentesque. Mauris sit amet pulvinar velit, at dignissim lacus." & _
"Maecenas non sollicitudin ex. Fusce luctus enim eff43icitur aliquet finibus. Nam ac 1fermentum lacus."
arr = Split(str, " ")
For i = LBound(arr) To UBound(arr)
Counter = 0
For y = 1 To Len(Trim(arr(i)))
If IsNumeric(Mid(Trim(arr(i)), y, 1)) Then
Counter = Counter + 1
End If
If Counter >= 3 Then
Debug.Print Replace(Trim(arr(i)), ",", "")
Exit For
End If
Next y
Next i
End Sub
虽然不是防弹的，但您可以使用此功能：
Function GetNumbersWithAtLeastThreeDigits(ByVal s As String) As String
Dim charsToRemove As String
charsToRemove = "abcdefghijklmnopqrstuvwxyz.,"
s = LCase(s)
Dim i As Long
For i = 1 To Len(charsToRemove)
s = Replace(s, Mid(charsToRemove, i, 1), "")
Next
Dim res As String
Dim v As Variant
For Each v In Split(WorksheetFunction.Trim(s), " ")
If CLng(Val(v)) > 99 Then res = res & Val(v) & vbNewLine
Next
GetNumbersWithAtLeastThreeDigits = res
End Function
它将返回一个字符串，该字符串包含所有找到的数字除以换行符虽然不是防弹的，但您可以使用此函数：
Function GetNumbersWithAtLeastThreeDigits(ByVal s As String) As String
Dim charsToRemove As String
charsToRemove = "abcdefghijklmnopqrstuvwxyz.,"
s = LCase(s)
Dim i As Long
For i = 1 To Len(charsToRemove)
s = Replace(s, Mid(charsToRemove, i, 1), "")
Next
Dim res As String
Dim v As Variant
For Each v In Split(WorksheetFunction.Trim(s), " ")
If CLng(Val(v)) > 99 Then res = res & Val(v) & vbNewLine
Next
GetNumbersWithAtLeastThreeDigits = res
End Function
它将返回一个字符串，其中包含所有找到的数字除以换行符这听起来像是正则表达式的例子。^这里有一个指向VBA中正则表达式的链接。这绝对是你想要用的@Warcupine肯定会在未来的工作中研究正则表达式。谢谢这听起来像是正则表达式的例子。^这里有一个指向VBA中正则表达式的链接。这绝对是你想要用的@Warcupine肯定会在未来的工作中研究正则表达式。谢谢你工作得很有魅力谢谢！我不得不做一些小的修改以将其包含在我的脚本中，而且显然CLng不够大，所以我不得不使用CDbl。工作得很有魅力谢谢！我不得不做一些小的修改以将其包含在我的脚本中，而且显然CLng不够大，所以我不得不使用CDbl。