整理并查找数据

有一大文件不以 c:111.txt,大于 500K,内有数据如下
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**
7a 8b 5d 17c 9d**
7a 8b 5d**
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**
3d 4b** 7b 8b 5d 17c 9d**
7c 8a 5d 17c 9d** 8a 9c**
...
...
... 里面有 3a 4d** ; 7a 8b 9d** ;7a 8b 5d 17c 9d** ;7a 8b 5d 17c**;这几种格式的数据
我想取出其中只有 7a 8b 5d 17c 9d** 格式的行 (7a 8b 5d 17c 9d**不是固定的也可能是 99a 18b 15d 17c 9d**)
并且这样的行至少包括有一个 3a 4d** 这样格式的行 .如 :
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**          ok
7a 8b 5d 17c 9d**                             x
7a 8b 5d**                                     x
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**             ok
3d 4b** 7b 8b 5d 17c 9d**                     ok
7c 8a 5d 17c 9d** 8a 9c**                      ok
...
...
...
打 OK的行为合格 ,其它则不需要 ,然后合格的行则保存在 d:222.txt中 ,一行行的保存
这是第一步 .第 2步为查找 .
例子
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**
7a 8b 5d 17c 9d**
7a 8b 5d**
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**
3d 4b** 7b 8b 5d 17c 9d**
7c 8a 5d 17c 9d** 8a 9c**                      我要查找例子中有 3a 4b** 的行 .取出所有并保存在 d:333.txt中
对特别注意的是 3a 4b** 也可是以  3c 4d** 3b 4a** 3a 4c** 就是说只要有 3 4 而不管 3 4 后面的字符是什么
都符合条件 .
第 2步我给出的只是个例子 .实际中应该是查找第一步中保存在 d:222.txt中的所有数据 ,而且 3a 4b**
不是固定的也  可以是 4b 7d** 或 6d 7c**或其它任意，但必须是 2个字符组成如 2c 8b** ; 5d 8b** ; 9c 7d**等
注意只能是这样格式的，不能从 3c 4d 5b 6d 7c**这种格式里查找。
最后查找出来的结果应为：
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**
3d 4b** 7b 8b 5d 17c 9d**
...
...
...
然后把所有符  合要求的行保存在 d:333.txt中
而且要求  查找的 3a 4b**改为 5c 6d**也行。暂时就这么多。我不清楚是用数据库来做还是用文件做好。因为数据库我懂得实在太少。
分不够可以再加，有什么其它需要也可以跟我谈，  最好有程序。谢了。

解决方案 »

免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货

第一个条件:      找到至少包含一个"XX XX**"这种格式字符串的行,并保存于222.TXT;第二个条件:      从上面的222.TXT里再找到包含"XX XX**"这种格式字符串的行,并保存于333.TXT;这样的代码很好写;但是我没明白你这两个条件有什么不同.....先睡觉~~
第一个条件为    找到至少包含一个"XX XX**"这种格式字符串的行,并保存于222.TXT;   "xx xx**"为所有的 ,符合条件的行
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**          ok
7a 8b 5d 17c 9d**                             x
7a 8b 5d**                                     x
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**             ok
3d 4b** 7b 8b 5d 17c 9d**                     ok
7c 8a 5d 17c 9d** 8a 9c**                      ok
...
...
...
打 OK的符合条件第二个条件的  "xx xx**"为特定的 .是我输入一个需要查找的 "xx xx**如 3a 4b**然后从 222.txt中找出所有
3a 4b** 其中 a b不是固定的 ,可以是 3b 4d** 或者 3 c 4 c** 但 3 4 一定要相同 ,然后应该以
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**
3d 4b** 7b 8b 5d 17c 9d**
...
...
...
这样的格式查找出来 .
好像  第一个条件也有点多佘 ,不要也行 ,主要是为了说得更清楚一些 .关键  是第二步 .
Option ExplicitFunction TestStr(ByVal s As String) As Boolean
    '你的要求：找到至少包含一个"XX XX**"这种格式字符串的行
    '我的理解：数字+字符+空格+数字+字符+**
    '本来可以用like判断，只是不知道你数字有几位，所以用了Replace过滤
    Dim i As Integer
    If UBound(Split(s, Chr(32))) = 1 Then  '包含一个空格
        For i = 0 To 9
            s = Replace(s, i, "")
        Next
        s = Replace(s, Chr(32), "")
        If Len(s) = 2 Then TestStr = True  '过滤掉数字和空格还有二个字符
    End If
End FunctionPrivate Sub Command1_Click()
    Dim h As Long
    Dim sFile As String
    Dim sLine() As String
    Dim sTmp() As String
    Dim i As Long, j As Long

    h = FreeFile
    Open "D:\test.txt" For Binary As h
        sFile = Space(LOF(h))
        Get h, , sFile
    Close

    sLine = Split(Trim(sFile), vbCrLf)          '分行
    h = FreeFile
    Open "d:\test2.txt" For Output As h
        For i = 0 To UBound(sLine)
            sTmp = Split(Trim(sLine(i)), "**")  '按**分组
            j = UBound(sTmp)
            Do While j > 0
                If TestStr(Trim(sTmp(j))) Then
                    Print #h, sLine(i)
                    Exit Do
                End If
                j = j - 1
            Loop
        Next
    Close
End Sub第一个就这个样吧？第二个思路也差不多吧？现在没空写了.......
3a 4d** ; 7a 8b 9d** ;7a 8b 5d 17c 9d** ;7a 8b 5d 17c**;这几种格式是有区别的
3a 4d** 只有 2个数据
7a 8b 9d** 有三个数据
7a 8b 5d 17c 9d** 有五个数据
7a 8b 5d 17c** 有 4个数据
第一个条件就是说到查找一个有五个数据的行 ,并且这行至少有一个 2 个数据
如 7a 8b 5d 17c 9d**  3a 4d**
也可以有 2个以上的 2个数据如 3c 4d** 7b 8c 5d 17c 9d** 8a 9c**
注 **不是数据只是一种分翮数据数据的符号
以下几种都打 OK的为符合条件的
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**          ok
7a 8b 5d 17c 9d**                             x
7a 8b 5d**                                     x
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**             ok
3d 4b** 7b 8b 5d 17c 9d**                     ok
7c 8a 5d 17c 9d** 8a 9c**                      ok
OK, 第一条件 vbman2003已经把它做出来了 .
现在就差第 2步了 .
好象不完全正确啊，我改一下，你看看那一个对，没时间细想，只是给你一个思路而已
Option ExplicitFunction TestStr1(ByVal s As String) As Boolean
    '你的要求：找到至少包含一个"XX XX**"这种格式字符串的行
    '我的理解：数字+字符+空格+数字+字符+**
    '本来可以用like判断，只是不知道你数字有几位，所以用了Replace过滤
    Dim i As Integer
    If UBound(Split(s, Chr(32))) = 1 Then  '包含一个空格
        For i = 0 To 9
            s = Replace(s, i, "")
        Next
        s = Replace(s, Chr(32), "")
        If Len(s) = 2 Then TestStr1 = True  '过滤掉数字和空格还有二个字符
    End If
End FunctionFunction TestStr2(ByVal s As String) As Boolean
    '你的要求：找一个有五个数据的行
    Dim i As Integer
    If UBound(Split(s, Chr(32))) = 4 Then
        For i = 0 To 9
            s = Replace(s, i, "")
        Next
        s = Replace(s, Chr(32), "")
        If Len(s) = 5 Then TestStr2 = True  '过滤掉数字和空格还有5个字符
    End If
End FunctionPrivate Sub Command1_Click()
    Dim h As Long
    Dim sFile As String
    Dim sLine() As String
    Dim sTmp() As String
    Dim i As Long, j As Long
    Dim b(1) As Boolean

    h = FreeFile
    Open "D:\test.txt" For Binary As h
        sFile = Space(LOF(h))
        Get h, , sFile
    Close

    sLine = Split(Trim(sFile), vbCrLf)          '分行
    h = FreeFile
    Open "d:\test2.txt" For Output As h
        For i = 0 To UBound(sLine)
            b(0) = False: b(1) = False
            sTmp = Split(Trim(sLine(i)), "**")  '按**分组
            j = UBound(sTmp)
            Do While j >= 0
                If TestStr1(Trim(sTmp(j))) Then b(0) = True
                If TestStr2(Trim(sTmp(j))) Then b(1) = True
                If b(0) = True And b(1) = True Then
                    Print #h, sLine(i)
                    Exit Do
                End If
                j = j - 1
            Loop
        Next
    Close
End Sub测试数据：
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**
7a 8b 5d 17c 9d**
7a 8b 5d**
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**
3d 4b** 7b 8b 5d 17c 9d**
7c 8a 5d 17c 9d** 8a 9c**
7c 8a**  结果：
3a 4b** 11b 12d** 7a 8b 5d 17c 9d**
3c 4d** 7b 8c 5d 17c 9d** 8a 9c**
3d 4b** 7b 8b 5d 17c 9d**
7c 8a 5d 17c 9d** 8a 9c**                        第二个道理一样
又想了一下,楼主是不是要的是这样的效果:输入指定的关键字,要求把"包含指定关键字" AND "关键字前面无字符 OR 关键字前面只能是'** '"这样的行提出来.那其实直接整合成一个就可以了大概.测试代码如下:'窗体里添加一个按钮就行.
Option ExplicitPrivate Function GetText(ByVal InFileName As String, ByVal OutFileName As String, ByVal SearchStr As String) As Long
    '从A文件里找到符合条件的行,写到B文件里去
    'InFileName - 源文件
    'OutFileName - 目标文件
    'SearchStr - 要查找的字符串
    '返回值:
    '       写入到目标文件中的行数
    Dim lOutLine As Long, Buff As String, StrLine() As String, SearchStrLen As Long
    Dim I As Long, J As Long, bAddStr As Boolean

    SearchStrLen = Len(SearchStr)           '关键字长度
    lOutLine = 0
    GetText = 0

    Open InFileName For Binary As #1        '一次性读入文本到内存
        Buff = String(LOF(1), Chr(0))
        Get 1, , Buff
    Close #1

    StrLine = Split(Buff, vbCrLf)           '按行分割

    Open OutFileName For Binary As #2       '写回文件
        For I = 0 To UBound(StrLine)
            bAddStr = False
            J = InStr(1, StrLine(I), SearchStr)     '一行一行地找
            If J > 0 Then                       '先确认是否包含要查找的字符串,再确认字符串出现的条件是否符合
                If J = 1 Then                   '如果是在行首找到的,那就肯定符合,通过.
                    bAddStr = True
                ElseIf Mid(StrLine(I), J - SearchStrLen, SearchStrLen) = "** " Then       '如果不是行首,就判断其前面三个字符
                    bAddStr = True
                End If
                If bAddStr = True Then
                    Put 2, , StrLine(I) & vbCrLf            '符合条件就写到目标文件里去.
                    lOutLine = lOutLine + 1                 '记录行数
                End If
            End If
        Next
    Close #2

    GetText = lOutLine
End FunctionPrivate Sub Command1_Click()
    Debug.Print GetText("d:\temp\1.txt", "D:\temp\2.txt", "3a 4b**")
End Sub感觉把"** "这个前缀也做成参数应该能适应更多的工作方式.就是不知道要的是不是这种效果,解说得有些让人不是很明白.
晕倒,发现问题了~~ElseIf Mid(StrLine(I), J - SearchStrLen, SearchStrLen) = "** " Then       '如果不是行首,就判断其前面三个字符
'这里搞错了.我是脑袋里在想着把那个**加空格做成参数,于是就可以用这个变量....汗.
'应该改成如下:
ElseIf Mid(StrLine(I), J - 3, 3) = "** " Then       '如果不是行首,就判断其前面三个字符
'这里的3就是那个前缀的长度.....
'函数首部的这一句:
SearchStrLen = Len(SearchStr)           '关键字长度
'无作用了.....汗.
'在Form1上添加两个文本框Text1、Text2，二个命令按钮command1,command2,2个标签label1,label2
'在设计程序时，将以下设置好。设计时才有效。不能在运行时设置。
'Text1.MultiLine = true
'Text2.MultiLine = true
'Text1.ScrollBars = 3
'Text2.ScrollBars = 3Option ExplicitDim TXTline$() '取得一行数据并放到数组中
Dim FileNumber&, i%, j%, LineIndex#
Dim cTXTValue$, S1$, S2$, S3$
Private Sub Command1_Click()
        Text1.Text = ""
        Text2.Text = ""
        If Dir("c:\111.txt") <> "" Then SeekWord ("c:\111.txt")
End SubPrivate Sub Command2_Click()
        Text2.Text = ""
        If Text1.Text <> "" Then ReplaceWord
End SubPrivate Sub Form_Load()
        Text1.Text = ""
        Text2.Text = ""
        'LineIndex = 0
        Command1.Caption = "开始"
        Command2.Caption = "替换"
End Sub

'查找TXT文件中包含特定字符9d**或者9D**的行
'并且行至少包含一个NL NL**的行，N代表数字，L代表字母。N可以是1位数或2位数及以上
Private Function SeekWord(cFile As String) As Boolean

        Dim ID$, ID9d$ '标识符
        Dim PO1%, PO2%
        Dim SubLine$() '子数组
        ID = "**": ID9d = "9d**" '标识符
        LineIndex = 0
        'i = 0
        FileNumber = FreeFile
        Open (cFile) For Input As #FileNumber '打开文件
        Do While Not EOF(FileNumber)
           Line Input #FileNumber, cTXTValue '读取一行文本
           cTXTValue = Trim(cTXTValue)
           PO1 = InStr(1, cTXTValue, LCase(ID9d)) '包含9d**的行
           PO2 = InStr(1, cTXTValue, UCase(ID9d)) '包含9D**的行
           If (Len(cTXTValue) <> 0) And (PO1 > 0 Or PO2 > 0) Then '不是空行，且包含9d**或者9D**
              TXTline() = Split(cTXTValue, "**") '将一行拆分到数组中
              For i = 0 To UBound(TXTline)
                  TXTline(i) = Trim(TXTline(i))
                  S1 = TXTline(i)
                  If Right(S1, 2) = "9d" Or Right(S1, 2) = "9D" Then GoTo cjl

                  'If Len(S1) <> 5 Then GoTo cjl
                  'S2 = Mid(S1, 1, 1): S3 = Mid(S1, 4, 1)
                  'If IsNumeric(S2) = True And IsNumeric(S3) = True Then '判断1、4位是否为数字
                  '   S2 = Mid(S1, 2, 1): S3 = Mid(S1, 5, 1)
                  '   If IsLetter(S2) = True And IsLetter(S3) = True Then '判断2、5位是否为字母
                  '      Text1.Text = Text1.Text & cTXTValue & vbCrLf '符合条件行的加入文本框Text1
                  '      LineIndex = LineIndex + 1
                  '      Label1.Caption = "已添加：" & LineIndex & "行"
                  '      Exit For
                  '   End If
                  'End If


                  SubLine() = Split(S1, " ")
                  For j = 0 To UBound(SubLine)
                      If UBound(SubLine) < 2 Then '规定只有2个元素，如：12c 3d**
                         SubLine(j) = Trim(SubLine(j))
                         S1 = SubLine(j)
                         S2 = Mid(S1, 1, Len(S1) - 1): S3 = Right(S1, 1)
                         If IsNumeric(S2) = True And IsLetter(S3) = True Then '判断是否前面数字，后面字母，如：12c 3d**
                            S1 = SubLine(j + 1)
                            S2 = Mid(S1, 1, Len(S1) - 1): S3 = Right(S1, 1)
                            If IsNumeric(S2) = True And IsLetter(S3) = True Then '判断是否前面数字，后面字母，如：12c 3d**
                               Text1.Text = Text1.Text & cTXTValue & vbCrLf '符合条件行的加入文本框Text1
                               LineIndex = LineIndex + 1
                               Label1.Caption = "已添加：" & LineIndex & "行"
                               Exit For
                            End If
                         End If
                      End If
                  Next

cjl:
              Next
           End If
           DoEvents
        Loop
        Close #FileNumber

        Text1.Text = Text1.Text & vbCrLf
        TXTline() = Split(Text1.Text, vbCrLf)
        If Dir("c:\222.txt") <> "" Then Kill ("c:\222.txt")
        FileNumber = FreeFile
        Open ("c:\222.txt") For Output Shared As #FileNumber '打开文件，准备保存
        For i = 0 To UBound(TXTline)
            If Len(TXTline(i)) <> 0 Then Print #FileNumber, Trim(TXTline(i))
            DoEvents
        Next
        Close #FileNumber
        Beep
End Function'查找的3a 4b**改为5c 6d**
'7c 8a 5d 17c 9d** 8a 9c**也应该符合第二个条件吧
Private Sub ReplaceWord()
        LineIndex = 0
        For i = 0 To UBound(TXTline)
            TXTline(i) = Trim(TXTline(i))
            If Len(TXTline(i)) <> 0 Then
               j = InStr(1, TXTline(i), "3a 4b**")
               If j > 0 Then
                  Mid(TXTline(i), j, Len("3a 4b**")) = "5c 6d**"
                  LineIndex = LineIndex + 1
                  Label2.Caption = "已更改：" & LineIndex & "行"
               End If
               Text2.Text = Text2.Text & TXTline(i) & vbCrLf
            End If
            DoEvents
        Next


        If Dir("c:\333.txt") <> "" Then Kill ("c:\333.txt")
        FileNumber = FreeFile
        Open ("c:\333.txt") For Output Shared As #FileNumber '打开文件，准备保存
        For i = 0 To UBound(TXTline)
            If Len(TXTline(i)) <> 0 Then Print #FileNumber, Trim(TXTline(i))
        Next
        Close #FileNumber
End Sub
'判断一个字符串是否全为字母
Private Function IsLetter(lstr As String) As Boolean
         Dim lstrlen%, i%, S$
         If Len(lstr) = 0 Then Exit Function
         IsLetter = True
         lstrlen = Len(lstr)
         For i = 1 To lstrlen
             S = Mid(lstr, i, 1)
             If Not ((Asc(S) > 64 And Asc(S) < 91) Or (Asc(S) > 96 And Asc(S) < 123)) Then
                IsLetter = False
                Exit Function
             End If
         Next
End Function
我做一个3.65M的文本文件做测试，结果要好几分钟，所以加了DoEvents。
测试的结果还不错！！
vbman2003 zuo de wo yong le bu cuo
chenji1031 ni xi ku le
wo wu bi huai le ,da bu zhi lai ,bu hao yi si
myjan ni ye xin ku le

整 理 并 查 找 数 据

解决方案 »

整理并查找数据