使用VBA在文本文件中搜索多个出现的字符串

Question

我有一个文本文件，其内容如下：

 The breakdown of MMS submissions by interface is... 
|    MM1 to MM1: 522245 messages (10.0% of submissions)
|    MM1 to MM3: 99360 messages (1.9% of submissions)
|    MM1 to MM4: 2393327 messages (46.0% of submissions)
|    MM3 to MM1: 14948 messages (0.3% of submissions)
|    MM4 to MM1: 2171419 messages (41.7% of submissions)
 ------------------
| The breakdown of MMS retrievals by interface is... 
|    MM1 to MM1: 2488980 messages (93.3% of retrievals)
|    MM3 to MM1: 11453 messages (0.4% of retrievals)
|    MM4 to MM1: 166323 messages (6.2% of retrievals)

我想要提取值522245，99360，2393327，14948，2171419，2488980，11453和166323并填入另一张表格。 请提供您的输入，就像我不知道可以在文本文件上工作的搜索功能一样。

Answer 1

以下是您问题的具体解决方案：

Sub GetNumbers()
'1. grab text from txt file using VBA stream reader
Dim txtpath As String: txtpath = "d:\t.txt"
Open txtpath For Input As #1
'2. read stream into a string type
Dim str As String
Do Until EOF(1)
Line Input #1, txtLine
str = str & txtLine
Loop
Close #1
Dim regex As Object
'3. regex
Set regex = CreateObject("Vbscript.regexp")
 With regex
.IgnoreCase = True
.MultiLine = True
.Pattern = "\s(\d+)\s"
.Global = True
End With
'4. paste values in the active sheet
Dim i As Integer:  i = 1
If regex.test(str) Then
For Each Match In regex.Execute(str)
ActiveSheet.Range("A" & i) = Replace(Match," ","")
i = 1 + i
Next
End If
End Sub

结果：

Answer 2

如果你的数据在ColumnA中，每个单元格开始＆＃34; MM＆＃34;，那么请尝试在B2中复制以适应：

=MID(A2,FIND(": ",A2)+2,FIND(" ",MID(A2,FIND(": ",A2)+2,10))-1)

对于VBA，首先启用Macro Recorder，然后根据需要将文本导入Excel。选择ColumnB，Copy，Paste Special，Values并将结果复制到所需的工作表。

Answer 3

可能的解决方案：

Sub ReadFromTextFile()
    Dim strFile As String: strFile = "C:\Users\Desktop\Tests\ReadFromText\ReadFile.txt"
    Dim strLine As String
    Dim strExtract As String
    Dim nLastRow As Long
    Dim nFnd As Long
    Dim nFndSpace As Long

    nLastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Close #1
    Open strFile For Input As #1

    Do Until EOF(1)
        Line Input #1, strLine
        If InStr(1, strLine, ":") > 0 Then
            nFnd = (InStr(1, strLine, ":")) + 2
            nFndSpace = InStr(nFnd, strLine, " ") - nFnd
            Cells(nLastRow, 1).Value = Mid(strLine, nFnd, nFndSpace)
            nLastRow = nLastRow + 1
        End If
    Loop


End Sub