使用 VBA 宏读取具有大行（超过 1024 个字符）的文本文件

Question

我需要从一个文本文件中选择一个特定的数据。但是这个文本文件的单行数据超过了 1024 个字符。

例如：我需要字符串 text1 和 text 2 之间的数据。我的代码只取大行中text1 和text2 之间的第一个数据，然后移至下一行。但是之前的大行有多个 text1 & text2 实例。我无法获得这些数据。请帮忙。在我的代码下面找到：

Sub Macro1()
  Dim dat As String
  Dim fn As String

  fn = "C:\Users\SAMUEL\Desktop\123\Source1.TXT" '<---- change here

  With CreateObject("Scripting.FileSystemObject").OpenTextFile(fn)
    Do While Not .AtEndOfStream
        dat = .Readline

        If InStr(1, dat, "text1", vbTextCompare) > 0 Then
           x = InStr(dat, "text1") + 8
           y = InStr(dat, "text2")
           Z = y - x

           MsgBox Mid(dat, x, Z)
        End If
    Loop
    .Close
  End With
End Sub

我想选择 Text1 和 Text2 之间的数据到特定的单元格。 数据看起来像“这是一个 Text1 很棒的 Text2 网站。我喜欢这个 Text1 网站 Text2。” 这是我从网站复制的大量数据。当我保存在文本文件中时，此 Web 数据的一行超过 4000 个字符。所以文本文件中的行以 1024 个字符结束，数据移动到下一行，变成 3 行。但是我的宏在字符串“dat”中取第一个 1024 并移动到网络数据的第二行，这意味着它会跳过 1024 个字符到 4000 个字符之后的所有数据。我想要的存在于 Text1 和 Text2 之间的数据可以是整个 4000 个字符中的任何位置，但它将采用相同的模式。它永远不会像 Text1...Text1...Text2..

Answer 1

使用regexp 是一种有用的方法，可以一次快速替换所有匹配项，或处理每个匹配项（包括每行多个匹配项），如下面的示例所示。

  Sub DisappearingSwannie()
  Dim objFSO As Object
  Dim objFil As Object
  Dim objRegex As Object
  Dim objRegMC As Object
  Dim objRegM As Object
  Dim strIn As String
  Dim X
  Dim lngCnt As Long
  Dim fn As String
  fn = "C:\temp\test.TXT" '<---- change here

  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objRegex = CreateObject("vbscript.regexp")
  Set objFil = objFSO.OpenTextFile(fn)
  X = Split(objFil.readall, vbNewLine)

  With objRegex
  .Global = True
  .Pattern = "text1(.+?)text2"
  End With

  For lngCnt = 1 To UBound(X)
  If objRegex.test(X(lngCnt)) Then
  Set objRegMC = objRegex.Execute(X(lngCnt))
  For Each objRegM In objRegMC
  Debug.Print "line " & lngCnt & " position:" & objRegM.firstindex
  Next
  End If
  Next

 End Sub

Answer 2

这是一个在 A1 和 B1 中查找 Text1 和 Text2 的宏。然后，它允许您选择要处理的文件并解析从 text1 到 text2 的子字符串。最后，将它们拆分为不超过 1024 个字符的块（确保每个块以空格结尾，以免拆分单词），并将它们写入从 A2 开始的 A 列中的一系列行。

子字符串的解析以及将它们分解为 1024 个字符块都是使用正则表达式完成的。 “工作”是在 VBA 数组中完成的，因为这比来回工作表要快。

由于字符串变量的长度可能约为 2^31 个字符，我怀疑您将整个文档读入单个变量然后处理它会不会有任何问题，而不是逐行处理。

由于宏有参数，您需要从另一个宏中调用它；或者更改代码以允许 text1 和 text2 的不同输入方法对您来说应该是微不足道的。

没有错误检查。

如果您不想在结果中包含 Text1 和 Text2，只需对正则表达式模式进行细微更改即可。

我使用早期绑定以便在编写宏时利用“提示”。这需要按照宏中的说明设置引用。但是，如果您愿意，可以将其更改为后期绑定应该很简单。

您也可以考虑进行修改，以便以某种方式将多行块与单行块区分开来。

享受

Option Explicit
'Set Reference to Microsoft Scripting Runtime
'Set Reference ot Microsoft VBScript Regular Expressions 5.5
Sub ExtractPhrases(Text1 As String, Text2 As String)
    Dim FSO As FileSystemObject
    Dim TS As TextStream
    Dim FN As File, sFN As String
    Dim RE As RegExp, MC As MatchCollection, M As Match
    Dim RE2 As RegExp, MC2 As MatchCollection, M2 As Match
    Dim sPat As String
    Dim S As String, sTemp As String
    Dim V() As Variant, vRes() As Variant
    Dim I As Long, J As Long, K As Long
    Dim C As Range
    Dim rRes As Range

'Get File path
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .ButtonName = "Process File"
    .Filters.Add "Text", "*.txt", 1
    .FilterIndex = 1
    .InitialView = msoFileDialogViewDetails
    If .Show = -1 Then sFN = .SelectedItems(1)
End With

'Read File into String variable
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(FileName:=sFN, IOMode:=ForReading, Create:=False)
S = TS.ReadAll

'Get results
Set RE = New RegExp
Set RE2 = New RegExp
With RE2
    .Global = True
    .MultiLine = False
    .Pattern = "(\S[\s\S]{1,1023})(?:\s+|$)"
End With
With RE
    .Global = True
    .IgnoreCase = True
    .Pattern = "\b" & Text1 & "\b([\s\S]+?)\b" & Text2 & "\b"
    If .Test(S) = True Then
        ReDim vRes(0)
        Set MC = RE.Execute(S)
        For I = 1 To MC.Count
            Set MC2 = RE2.Execute(MC(I - 1))
            ReDim V(1 To MC2.Count)
            For J = 1 To MC2.Count
                V(J) = MC2(J - 1).SubMatches(0)
            Next J
            ReDim Preserve vRes(UBound(vRes) + J - 1)
                For J = 1 To MC2.Count
                    K = K + 1
                    vRes(K) = V(J)
                Next J
        Next I
    End If
End With

vRes(0) = "Phrases"

'transpose vRes
ReDim V(1 To UBound(vRes) + 1, 1 To 1)
For I = 0 To UBound(vRes)
    V(I + 1, 1) = vRes(I)
Next I

Set rRes = Range("a2").Resize(rowsize:=UBound(V))
Range(rRes(1), Cells(Rows.Count, rRes.Column)).Clear
rRes = V


End Sub