如何从VBA中的文本字符串中提取数字

Question

我需要从文本字符串中提取数字，但我不太确定该怎么做。我在下面附加的代码是非常初步的，很可能可以更优雅地完成。我尝试解析的字符串示例如下：

“ ID CSys ID集ID集值集标题7026..Plate顶部MajorPrn应力7027..Plate顶部MinorPrn应力7033..Plate顶部VonMises应力”

我需要提取数字7026、7027和7033。字符串的长度将有所不同，我需要提取的值的数量也将有所不同。任何帮助将非常感激。谢谢！

Dim WrdArray() As String
Dim txtstrm As TextStream
Dim line As String
Dim clm As Long
Dim Rw As Long

'------------------------------------------------- -----------

Dim i As Long

Dim strPath As String
Dim strLine As String
Dim count, count1 As Integer
Dim holder As String
Dim smallSample As String

count = 0
count1 = 1
holder = ""

'Remove Filters and Add Custom Filters
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
Call Application.FileDialog(msoFileDialogOpen).Filters.Add("Text Files", "*.txt")
Call Application.FileDialog(msoFileDialogOpen).Filters.Add("Dat Files", "*.dat")

'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show

'determine what choice the user made
If intChoice <> 0 Then

'get the file path selected by the user
strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)

End If

'------------------------------------------------- -----------

If strPath <> "" Then
    Set txtstrm = FSO.OpenTextFile(strPath)
Else
    MsgBox "No file selected.", vbExclamation
    Exit Sub
End If

Rw = 1
Do Until txtstrm.AtEndOfStream
  line = txtstrm.ReadLine
  clm = 1
  WrdArray() = Split(line, " ") 'Change with ; if required

  For Each wrd In WrdArray()
     If Rw = 1 Then
        Do While count <> Len(wrd)
            smallSample = Left(wrd, 1)
            If smallSample = "0" Or smallSample = "1" Or smallSample = "2" Or smallSample = "3" Or smallSample = "4" _
                    Or smallSample = "5" Or smallSample = "6" Or smallSample = "7" Or smallSample = "8" _
                    Or smallSample = "9" Then
                holder = holder & smallSample
            Else
                If holder <> "" Then
                    Cells(count1, 1) = holder
                    count1 = count1 + 1
                End If
                holder = ""
            End If
            wrd = Right(wrd, Len(wrd) - 1)
            clm = clm + 4
            ActiveSheet.Cells(Rw, clm) = holder
        Loop
     Else
        ActiveSheet.Cells(Rw, clm) = wrd
        clm = clm + 1
     End If
  Next wrd
  Rw = Rw + 1
Loop
txtstrm.Close

结束子

Answer 1

您可以使用Regular Expressions。

Sub ExtractNumbers()
    Dim str As String, regex As regExp, matches As MatchCollection, match As match

    str = "ID CSys ID Set ID Set Value Set Title 7026..Plate Top MajorPrn Stress 7027..Plate Top MinorPrn Stress 7033..Plate Top VonMises Stress"

    Set regex = New regExp
    regex.Pattern = "\d+"      '~~~> Look for variable length numbers only
    regex.Global = True

    If (regex.Test(str) = True) Then
        Set matches = regex.Execute(str)   '~~~> Execute search

        For Each match In matches
            Debug.Print match.Value '~~~> Prints: 7026, 7027, 7033
        Next
    End If
End Sub

确保您引用了VBA正则表达式库：

1. 打开VBA编辑器
2. 工具>参考...
3. 校验 Microsoft VBScript Regular Expression 5.5