Question

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

例如：我需要字符串text1和text 2之间的数据。我的代码只使用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＆amp;文本2。我无法获得这些数据。请帮忙。在下面找到我的代码：

{{1}}

我想在Text1和Text2之间选择一个特定单元格的数据。数据看起来像“这是一个Text1非常棒的Text2网站。我喜欢这个Text1网站Text2。” 这是我从网站上复制的巨大数据。当我保存在文本文件中时，此Web数据的一行超过4000个字符。因此，文本文件中的行以1024个字符结束，数据移动到下一行，变为3行。但我的宏在字符串“dat”中取第一个1024并移动到第二行Web数据，这意味着它会在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个字符的块（确保每个块以一个空格结束，以便不分割单词），并将它们写入A列中的一系列行，从A2开始。

使用正则表达式完成子字符串的解析以及将它们分解为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

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

2 个答案: