分 析 文 本

[jp0077777]

想 对 TXT文 件 进 行 字 符 分 析 ,并 提 取 其 中 需 要 的 内 容
例 子 :文 件 中 有 如 下 内 容 :

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
fffffffffffffff uuuuu[ghghg] *******
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [rewreererwerwrewr] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
fsdfdsfdsfdsf mmmmm[tttt] *******
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [rewrewrererewrewr] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [rewrewrererewrewr] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccccccc
dddddddddddddddddddddddddd [fdfdfds]
eeeeeeeeeeeeeeeee [fdsfsdf ]
ggggggggggggggggggggg uuuuu [gggggg] *******
bbbbb [ererew] ******
sdsadsadsadsadsad
dsadsadsadsdsa mmmmm[yyyy] *****
dfdsfsdfdsfdsf
dfsdfsdfsdfdsfdfdf

一 共 有 4 个 段落 ， 我 想 取 得 每 个 段落 中 uuuuu bbbbb mmmmm 后 []内 的 内 容 ， 也 就 是 打 了 星 号 行 []中 的 内 容 ，
实 际 文 件 中 没 有 *号 。 然 后 将 每 个 段落中 取 得 的 UUUUU BBBBB MMMMM后 []内 的 内 容 保 存 在 一 行
并 显 示 在 另 外 一 个 文 件 中 ， 这 样 4个 段落 中 共 有 4行 数 据 要 保 存 在 另 外 一 个 文 件 中 。
并 且 还 要 加 一 个 条 件 BBBBB后 的 []中 的 内 容 长 度 要 大 于 22 ， UUUUU BBBBB MMMMM后 []中 的 内 容 才 保 存
这 只 是 一 个 例 子 ， 真实 际 文 件 中 的 段落 比 这 个 例 子 多 很 多 。， 文 件 很 大 ， 所 以 程 序 最 好 是 通 用 的 。 谢 了 。 急 用 。
最 好 有 源 程 序 。

[silencenet]

这个问题用VB现有的函数执行效率上明显不足
建议用正则
参考例子:http://user.qzone.qq.com/241220652/blog/1203391650
-_-! 当年放到QQ空间了
速度绝对可以
这里还有测试效率：http://user.qzone.qq.com/241220652/blog/1203398032

[东方之珠]

改成这样，肯定会快很多：

'在Form1上添加两个文本框Text1、Text2，一个命令按钮command1
'在设计程序时，将以下设置好。设计时才有效。不能在运行时设置。
'Text1.MultiLine = true
'Text2.MultiLine = true
'Text1.ScrollBars = 3
'Text2.ScrollBars = 3

Option Explicit

Private Sub Command1_Click()
        Text1.Text = ""
        Text2.Text = ""
        ReadFile_GetWord ("d:\cjl.txt")
End Sub

'传送TXT文件，取得“[]”中的内容，并保存为文件
Private Function ReadFile_GetWord(cFile As String) As Boolean
        
        Dim FileCount% ', cFileCount%
        Dim cTXTValue$, FileNumber&, U$, B$, M$
        Dim S$, ARR$()
        Dim IsBBBBB22 As Boolean, TT%
        Dim V1%, V2%
        
        U = "uuuuu": B = "bbbbb": M = "mmmmm" '每个段落中的标识符，字符数可自定
        IsBBBBB22 = False: TT = 22 'BBBBB后面的[]内字符数大于22
        'FileCount = 0
        FileNumber = FreeFile
        Open (cFile) For Input As #FileNumber '打开文件
        Do While Not EOF(FileNumber)
           Line Input #FileNumber, cTXTValue '读取一行文本到变量cTXTValue
           cTXTValue = Trim(cTXTValue)
           If Len(cTXTValue) = 0 And Len(Text1.Text) = 0 Then '迈开文件开头多余的空行
              GoTo chenjl1031
           Else
              '开始读取每一段的内容
              If Len(cTXTValue) = 0 And Len(Text1.Text) <> 0 Then '表示一段读取完毕
                 'FileCount = FileCount + 1 '统计段落数
                 Text1.Text = Text1.Text & vbCrLf '每显示完一个段落换行
                 Text2.Text = Text2.Text & vbCrLf '每一段规定内容显示完毕后换行
                 'Text2.Text = Text2.Text & "(第" & Trim(FileCount) & "段)" & vbCrLf '每一段规定内容显示完毕后换行
              Else
                 Text1.Text = Text1.Text & cTXTValue & vbCrLf  '每读一行都复制到文本框Text1
                 '以下6行是将uuuuu bbbbb mmmmm 后 []内 的 内 容保存到文本框Text2中
                 If InStr(1, cTXTValue, LCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    V1 = InStr(1, cTXTValue, LCase(U)) + Len(LCase(U))
                    V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U))
                    S = Mid(cTXTValue, V1, V2)
                    V1 = InStr(1, S, "[") + 1
                    V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
                    S = Mid(S, V1, V2)
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, LCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    V1 = InStr(1, cTXTValue, LCase(B)) + Len(LCase(B))
                    V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(B)) - Len(LCase(B))
                    S = Mid(cTXTValue, V1, V2)
                    V1 = InStr(1, S, "[") + 1
                    V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
                    S = Mid(S, V1, V2)
                    If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, LCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    V1 = InStr(1, cTXTValue, LCase(M)) + Len(LCase(M))
                    V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(M)) - Len(LCase(M))
                    S = Mid(cTXTValue, V1, V2)
                    V1 = InStr(1, S, "[") + 1
                    V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
                    S = Mid(S, V1, V2)
                    Text2.Text = Text2.Text & S & " "
                 End If
                 
                 If InStr(1, cTXTValue, UCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    V1 = InStr(1, cTXTValue, UCase(U)) + Len(UCase(U))
                    V2 = Len(cTXTValue) - InStr(1, cTXTValue, UCase(U)) - Len(UCase(U))
                    S = Mid(cTXTValue, V1, V2)
                    V1 = InStr(1, S, "[") + 1
                    V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
                    S = Mid(S, V1, V2)
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, UCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    V1 = InStr(1, cTXTValue, UCase(B)) + Len(UCase(B))
                    V2 = Len(cTXTValue) - InStr(1, cTXTValue, UCase(B)) - Len(UCase(B))
                    S = Mid(cTXTValue, V1, V2)
                    V1 = InStr(1, S, "[") + 1
                    V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
                    S = Mid(S, V1, V2)
                    If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, UCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    V1 = InStr(1, cTXTValue, UCase(M)) + Len(UCase(M))
                    V2 = Len(cTXTValue) - InStr(1, cTXTValue, UCase(M)) - Len(UCase(M))
                    S = Mid(cTXTValue, V1, V2)
                    V1 = InStr(1, S, "[") + 1
                    V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
                    S = Mid(S, V1, V2)
                    Text2.Text = Text2.Text & S & " "
                 End If
              End If
           End If
           'cFileCount = cFileCount + 1
chenjl1031:
        Loop
        Close #FileNumber
        
        Text2.Text = Text2.Text & vbCrLf '多加一回车换行
        ARR = Split(Text2.Text, vbCrLf) '每一段规定内容转换到数组ARR中
        'Debug.Print ARR(0), ARR(1), ARR(2), ARR(3)
     
        If Dir("d:\cjl_1.txt") <> "" Then Kill ("d:\cjl_1.txt")
        FileNumber = FreeFile
        Open ("d:\cjl_1.txt") For Output Shared As #FileNumber '打开文件，准备保存
              If IsBBBBB22 Then
                 For FileCount = 0 To UBound(ARR)
                     If Len(ARR(FileCount)) <> 0 Then Print #FileNumber, Trim(ARR(FileCount))
                 Next
              End If
        Close #FileNumber
End Function

[forbearORfolie]

这77—7和88—8是不是一个集团的？

[jp0077777]

88没 分 了 .换 77了

[jp0077777]

也 没 有 死 掉 .就 是 很 慢 .5分 钟 以 上 .我 还 以 为 程 序 死 了 .
还 行 吧 .结 贴 .谢 了 .

[东方之珠]

'在Form1上添加两个文本框Text1、Text2，一个命令按钮command1
'在设计程序时，将以下设置好。设计时才有效。不能在运行时设置。
'Text1.MultiLine = true
'Text2.MultiLine = true
'Text1.ScrollBars = 3
'Text2.ScrollBars = 3

Option Explicit

Private Sub Command1_Click()
        Text1.Text = ""
        Text2.Text = ""
        ReadFile_GetWord ("d:\cjl.txt")
End Sub

'传送TXT文件，取得“[]”中的内容，并保存为文件
Private Function ReadFile_GetWord(cFile As String) As Boolean
        
        Dim FileCount% ', cFileCount%
        Dim cTXTValue$, FileNumber&, U$, B$, M$
        Dim S$, ARR$()
        Dim IsBBBBB22 As Boolean, TT%
        
        U = "uuuuu": B = "bbbbb": M = "mmmmm" '每个段落中的标识符，字符数可自定
        IsBBBBB22 = False: TT = 22 'BBBBB后面的[]内字符数大于22
        'FileCount = 0
        FileNumber = FreeFile
        Open (cFile) For Input As #FileNumber '打开文件
        Do While Not EOF(FileNumber)
           Line Input #FileNumber, cTXTValue '读取一行文本到变量cTXTValue
           cTXTValue = Trim(cTXTValue)
           If Len(cTXTValue) = 0 And Len(Text1.Text) = 0 Then '迈开文件开头多余的空行
              GoTo chenjl1031
           Else
              '开始读取每一段的内容
              If Len(cTXTValue) = 0 And Len(Text1.Text) <> 0 Then '表示一段读取完毕
                 'FileCount = FileCount + 1 '统计段落数
                 Text1.Text = Text1.Text & vbCrLf '每显示完一个段落换行
                 Text2.Text = Text2.Text & vbCrLf '每一段规定内容显示完毕后换行
                 'Text2.Text = Text2.Text & "(第" & Trim(FileCount) & "段)" & vbCrLf '每一段规定内容显示完毕后换行
              Else
                 Text1.Text = Text1.Text & cTXTValue & vbCrLf  '每读一行都复制到文本框Text1
                 '以下6行是将uuuuu bbbbb mmmmm 后 []内 的 内 容保存到文本框Text2中
                 If InStr(1, cTXTValue, LCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(U)) + Len(LCase(U)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U)))
                    S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, LCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(B)) + Len(LCase(B)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(B)) - Len(LCase(B)))
                    S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
                    If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, LCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(M)) + Len(LCase(M)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(M)) - Len(LCase(M)))
                    S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
                    Text2.Text = Text2.Text & S & " "
                 End If
                 
                 If InStr(1, cTXTValue, UCase(U)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    S = Mid(cTXTValue, InStr(1, cTXTValue, UCase(U)) + Len(UCase(U)), Len(cTXTValue) - InStr(1, cTXTValue, UCase(U)) - Len(UCase(U)))
                    S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, UCase(B)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    S = Mid(cTXTValue, InStr(1, cTXTValue, UCase(B)) + Len(UCase(B)), Len(cTXTValue) - InStr(1, cTXTValue, UCase(B)) - Len(UCase(B)))
                    S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
                    If Len(B) > TT Then IsBBBBB22 = True '标识符BBBBB后面[]内容长度大于22
                    Text2.Text = Text2.Text & S & " "
                 End If
                 If InStr(1, cTXTValue, UCase(M)) > 0 And InStr(1, cTXTValue, "[") > 0 Then
                    S = Mid(cTXTValue, InStr(1, cTXTValue, UCase(M)) + Len(UCase(M)), Len(cTXTValue) - InStr(1, cTXTValue, UCase(M)) - Len(UCase(M)))
                    S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)
                    Text2.Text = Text2.Text & S & " "
                 End If
              End If
           End If
           'cFileCount = cFileCount + 1
chenjl1031:
        Loop
        Close #FileNumber
        
        Text2.Text = Text2.Text & vbCrLf '多加一回车换行
        ARR = Split(Text2.Text, vbCrLf) '每一段规定内容转换到数组ARR中
        'Debug.Print ARR(0), ARR(1), ARR(2), ARR(3)
     
        If Dir("d:\cjl_1.txt") <> "" Then Kill ("d:\cjl_1.txt")
        FileNumber = FreeFile
        Open ("d:\cjl_1.txt") For Output Shared As #FileNumber '打开文件，准备保存
              If IsBBBBB22 Then
                 For FileCount = 0 To UBound(ARR)
                     If Len(ARR(FileCount)) <> 0 Then Print #FileNumber, Trim(ARR(FileCount))
                 Next
              End If
        Close #FileNumber
End Function

[jp0077777]

有 个 问 题 ,当 文 件 比 较 大 时 程 序 会 死 掉 .比 如 文 件 大 于 500K以 上

[jp0077777]

有 个 问 题 ,当 文 件 比 较 大 时 程 序 会 死 掉 ,比 如 文 件 大 于 500K以 上

[jp0077777]

文 件 大 于 700K,程 序 没 有 死 掉 .但 执 行 很 慢 .要 5分 钟 以 上 .我 先 还 以 为 死 掉 了 .
当 文 件 为 1.25M时 死程 序 死 掉 了 .

[Sandrer]

在三楼的代码中增加一个“DoEvents”
就在Do While Not EOF(FileNumber)下面加

这样的话程序不会死掉，不过所需时间会增加！

[vbman2003]

用正则试试

[jasonXiaoSQL]

程序用上Doevents但不要去考虑多线程.
多线程控制内存有问题.

建议加上DoEvents再配上正则.
你这个用正则应该很容易

[东方之珠]

执行大文件，程序会死掉！小文件肯定没问题，我反复测试过！
那肯定是计算那些S，S过于复杂了，把S拆开，分别计算：

S = Mid(cTXTValue, InStr(1, cTXTValue, LCase(U)) + Len(LCase(U)), Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U)))
S = Mid(S, InStr(1, S, "[") + 1, InStr(1, S, "]") - InStr(1, S, "[") - 1)

改为：
在ReadFile_GetWord开头再定义2个变量 Dim V1%, V2

V1 = InStr(1, cTXTValue, LCase(U)) + Len(LCase(U))
V2 = Len(cTXTValue) - InStr(1, cTXTValue, LCase(U)) - Len(LCase(U))
S = Mid(cTXTValue, V1, V2)
V1 = InStr(1, S, "[") + 1
V2 = InStr(1, S, "]") - InStr(1, S, "[") - 1
S = Mid(S, V1, V2)

这是改的LCase(U)，其他B、M作相应调整。再试看！