用EXCEL FSO 提取TXT文档某一特定行的关键词后的数据，该词多次出现，怎么调整代码？

guaner2008

我的代码：
Sub Clltxt()
    Dim p$, f$, fso As Object, Txt As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    r = Array("Wake", "N1", "N2", "N3", "REM") '!!
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.txt")
    ReDim arr(1 To 5000, 1 To 5) '!!上面关键字那里是几个，这里就把两个3换成几，比如4个，就是1 To 4000,1 To 4
    '!!下面就是循环当前文件夹下的txt文件，并匹配每个文件中的关键字，并把后面的数字取出来，注意要搜寻的txt中数值要和关键字在一行

    Do While f <> "" '
        k = k + 1
        Set Txt = fso.OpenTextFile(p & f, 1)
        s = Txt.readall
        For i = 0 To UBound(r)
            ar = Split(s, r(i))
            If UBound(ar) Then
                sr = Split(ar(1), vbCrLf)
                arr(k, i + 1) = sr(0)
            End If
        Next
        Txt.Close
        f = Dir
    Loop
    ActiveSheet.UsedRange.Offset(1).ClearContents
    [a2].Resize(k, UBound(arr, 2)) = arr
    Set Txt = Nothing
    Set fso = Nothing
    MsgBox "ok"
End Sub
---------------------------------


我的TXT文档：
这个文档有很多，这是其中一个文档的一部分内容：


入睡后清醒时间(min):                              65.5        REM密度：                                            11.7  
睡眠潜伏期 (min):                                     40.0        REM平均密度:                                       11.7      
REM潜伏期 (min):                                    17.0        睡眠效率 (%):                                       80.2

睡眠分期分析
睡眠分期        时间 (min)        占睡眠时间百分比（%）
Wake         105.5        
N1        15.0        3.5
N2        33.0        7.7
N3        0.0        0.0
REM        380.5        88.8

觉醒分析
觉醒类型        次数        指数
　　　　呼吸事件觉醒        124        17.4
腿动觉醒        2        0.3
自然觉醒        102        14.3
PLM觉醒        5        0.7
                   觉醒总计        233        32.6
周期性腿动统计  
        REM        NREM        Sleep
腿动次数总计        425        35        460
周期性腿动次数        284        24        308
周期性腿动指数        44.8        30.0        43.1

磨牙/颏肌肌电活动统计
        REM        NREM        Sleep
磨牙         0        1        1
磨牙         0.0        1.3        0.1

        SMA        TMA        合计
REM        13        112        125
SMA/TMA指数（次/小时）        2.0        17.7        19.7

REM        239               
---------------------------------------------
我想要的结果
105.5        15.03.5        33.07.7        0.00.0    380.588（这个数目前用我的代码出不了）可能因为最后一行有个REM，倒数第三行也有个REM。

有个朋友给我出了个意见，他认为

需要取的数据主要是下面这一段：

红框行是固定的，其他数据都是跟随其后的，因为有这个规律，代码就可以这样实现：可以删除这个特殊行之前的内容，然后删除随后一个空行（或者最大长度）之后的内容

代码例如：

s = Txt.readall

s=left(s, instr(s,"睡眠分期 时间 (min) 占睡眠时间百分比（%）"))

s=right(s, len(s)-instr(s,vbnewline & vbnewline))'删除空行之后的内容

debug.print f

debug.print s

但是我将这一部分加入原代码，运行后出现错误，
现在错误的代码是：

Sub Clltxt()
    Dim p$, f$, fso As Object, Txt As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    r = Array("Wake", "N1", "N2", "N3",

"REM"

) '!!
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.txt")
    ReDim arr(1 To 5000, 1 To 5) '!!上面关键字那里是几个，这里就把两个3换成几，比如4个，就是1 To 4000,1 To 4
    '!!下面就是循环当前文件夹下的txt文件，并匹配每个文件中的关键字，并把后面的数字取出来，注意要搜寻的txt中数值要和关键字在一行

    Do While f <> "" '
        k = k + 1
        Set Txt = fso.OpenTextFile(p & f, 1)
        s = Txt.readall
        

s=left(s, instr(s,"睡眠分期 时间 (min) 占睡眠时间百分比（%）"))

s=right(s, len(s)-instr(s,vbnewline & vbnewline))'删除空行之后的内容

debug.print f

debug.print s

For i = 0 To UBound(r)
            ar = Split(s, r(i))
            If UBound(ar) Then
                sr = Split(ar(1), vbCrLf)
                arr(k, i + 1) = sr(0)
            End If
        Next
        Txt.Close
        f = Dir
    Loop
    ActiveSheet.UsedRange.Offset(1).ClearContents
    [a2].Resize(k, UBound(arr, 2)) = arr
    Set Txt = Nothing
    Set fso = Nothing
    MsgBox "ok"
End Sub
出错的界面我已经上传。我的原始excel文件和两个测试的txt也已经上传
想请教各位，能不能帮我调试下。

guaner2008

不要沉啊  ：（

guaner2008

请高手指点

zpy2

guaner2008 发表于 2020-9-14 21:38
请高手指点

~(睡眠分期[\s\S]*)觉醒分析~

正则匹配？