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

时间:2018-06-22 20:03:29

标签: vba excel-vba excel

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

“ ID CSys ID集ID集值集标题7026..Plate Top MajorPrn Stress 7027..Plate Top MinorPrn Stress 7033..Plate Top VonMises Stress”

我需要提取数字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

结束子

3 个答案:

答案 0 :(得分:5)

您可以使用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 regex库:

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

答案 1 :(得分:2)

您可以使用此功能来拆分“单词”并测试数字:

Function numfromstring(str As String) As String
Dim strarr() As String
str = Replace(str, ".", " ")
strarr = Split(str)
Dim i As Long
For i = 0 To UBound(strarr)
    If IsNumeric(strarr(i)) Then
        numfromstring = numfromstring & "," & strarr(i)
    End If
Next i

numfromstring = Mid(numfromstring, 2)
End Function

您将使用以下公式从工作表中调用它:

=numfromstring(A1)

或者从vba像这样:

Sub try()
Dim str As String
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"

Dim out As String
out = numfromstring(str)

Debug.Print out
End Sub

如果您具有Office 365 Excel,则可以使用以下数组公式:

=TEXTJOIN(",",TRUE,IF(ISNUMBER(--TRIM(MID(SUBSTITUTE(SUBSTITUTE(A1,"."," ")," ",REPT(" ",99)),(ROW($1:$100)-1)*99+1,99))),TRIM(MID(SUBSTITUTE(SUBSTITUTE(A1,"."," ")," ",REPT(" ",99)),(ROW($1:$100)-1)*99+1,99)),""))

作为数组公式,退出编辑模式时需要使用Ctrl-Shift-Enter而不是Enter进行确认:

enter image description here

答案 2 :(得分:1)

要以所需的形式准确显示数字,请尝试以下操作:

Sub dural()
    Dim s As String, i As Long, L As Long, c As String, temp As String
    s = [A1]
    L = Len(s)
    temp = ""
    For i = 1 To L
        c = Mid(s, i, 1)
        If c Like "[0-9]" Then
            temp = temp & c
        Else
            temp = temp & " "
        End If
    Next i

    temp = "'" & Application.WorksheetFunction.Trim(temp)
    temp = Replace(temp, " ", ",")

    [B1] = temp
End Sub

enter image description here