从string中提取特定的长度数字，并用这些数字创build新的string
我有一个文本字段，我需要从中提取某些数字。 数字总是7位数字，但string中的位置是未知的，string中有多less也是未知的。
样本string是“SF WO 1564892 DUE 5/19 FIN WO 1638964 DUE 5/27”。 我希望能够提取1564892和1638964，并让它生成一个新的string，如“1564892; 1638964”，并继续添加“;数字”，如果有更多的string。 我使用新string来查找并返回这些数字中最大的一个。
我发现这样，它的作品，但它也会返回从string“123456789”，这是不受欢迎的“1234567”。
Public Function ExtractDigits(Alphanumeric As String, DigitLength As Long) Dim StringLenght As Long Dim CurrentCharacter As String Dim NewString As String Dim NumberCounter As Long Dim TempString As String StringLenght = Len(Alphanumeric) For r = 1 To StringLenght CurrentCharacter = Mid(Alphanumeric, r, 1) If IsNumeric(CurrentCharacter) Then NumberCounter = NumberCounter + 1 TempString = TempString & CurrentCharacter If NumberCounter = DigitLength Then If NewString = "" Then NewString = TempString Else NewString = NewString & ";" & TempString End If End If End If If Not IsNumeric(CurrentCharacter) Then NumberCounter = 0 TempString = "" End If Next ExtractDigits = NewString End Function 我宁愿解决scheme是在VBA中，而不是一个function，但我对任何东西都是开放的。
你的问题是否可以通过添加一个额外的If语句来解决，这个语句testing第七个数字后面的字符是否是一个数字，如果是这样的话，忽略数字？
Public Function ExtractDigits(Alphanumeric As String, DigitLength As Long) Dim StringLenght As Long Dim CurrentCharacter As String Dim NewString As String Dim NumberCounter As Long Dim TempString As String Dim r As Integer StringLenght = Len(Alphanumeric) For r = 1 To StringLenght CurrentCharacter = Mid(Alphanumeric, r, 1) If IsNumeric(CurrentCharacter) Then NumberCounter = NumberCounter + 1 TempString = TempString & CurrentCharacter If NumberCounter = DigitLength Then If (Not IsNumeric(Mid(Alphanumeric, r + 1, 1))) Then If NewString = "" Then NewString = TempString Else NewString = NewString & ";" & TempString End If End If End If End If If Not IsNumeric(CurrentCharacter) Then NumberCounter = 0 TempString = "" End If Next ExtractDigits = NewString End Function
你想要什么可以使用RegEx来实现，但是因为我正在走出所以这里是一个非常简单的替代 🙂
Sub Sample() Dim s As String Dim MyAr As Variant Dim i as Long s = "Thisis a Sample1234567-Blah12341234\1384156 Blah Blah 1375188 and more Blah 20 Section 1" For i = Len(s) To 1 Step -1 Select Case Asc(Mid(s, i, 1)) Case 48 To 57 Case Else s = Replace(s, Mid(s, i, 1), "a") End Select Next i Do While InStr(1, s, "aa") s = Replace(s, "aa", "a") Loop MyAr = Split(s, "a") For i = LBound(MyAr) To UBound(MyAr) If Len(Trim(MyAr(i))) = 7 Then Debug.Print MyAr(i) Next i ' ' This will Give you 1234567, 1384156 and 1375188 ' End Sub
编辑
逻辑
- 用任何字母表replace那个不是数字的string中的任何东西
- replace该字母表的两个instancs，直到剩下一个
- 拆分在那个字母表上
- 循环并检查长度。
- 我已经显示了这些数字。 你可以join他们
你可以使用正则expression式比循环整个string要容易得多。
正在使用的正则expression式是\b\d{7}\b ，这意味着由字边界分隔的7位数字。
Public Function ExtractDigits(Alphanumeric As String, DigitLength As Long) As String Dim regEx As Object, matches As Object Dim i As Long Dim output As String Set regEx = CreateObject("VBScript.RegExp") With regEx .Global = True .MultiLine = True .IgnoreCase = False .pattern = "\b\d{" & DigitLength & "}\b" End With Set matches = regEx.Execute(Alphanumeric) For i = 0 To matches.Count - 1 output = output & matches(i) & ";" Next If Len(output) > 0 Then output = Left(output, Len(output) - 1) ExtractDigits = output End Function
过去我面对过这样的事情，希望这种做法能够帮到你。
Function Extract7Digits(s As String) As String Dim i As Long Dim SevenDigits As String Dim s2 As String s2 = Replace(s, " ", "|") i = 1 While i < Len(s2) - 7 If IsNumeric(Mid(s2, i, 7)) Then SevenDigits = SevenDigits & Mid(s2, i, 7) & ";" i=i+6 End If i = i + 1 Wend Extract7Digits = SevenDigits End Function
最好。