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

Question

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

例如：我需要字符串text1和text 2之间的数据。我的代码只获取text1&text2，并移动到下一行。但前面的一行有多个text1&text2.我无法获取这些数据。请帮忙。在我的代码下面查找：

Sub Macro1()
Dim dat As String
Dim fn As String
fn = "C:UsersSAMUELDesktop123Source1.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，并移动到web数据的第二行，这意味着它跳过1024个字符到4000个字符之后的所有数据。我想要的存在于Text1和Text2之间的数据可以是4000个字符中的任何一个，但它将是相同的模式。它永远不会像Text1…Text1…Text2…那样

Answer 1

使用正则表达式是一种有用的方法，可以快速替换单个快照中的所有匹配项，或者像下面的示例一样处理每个匹配项(包括每行多个匹配项)。

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:temptest.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(包括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[sS]{1,1023})(?:s+|$)"
End With
With RE
.Global = True
.IgnoreCase = True
.Pattern = "b" & Text1 & "b([sS]+?)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