txt文件指定内容提取

ykcbf1100

提取TXT文件中指定数据

1. Sub ykcbf()   '//2024.6.27　　导入TXT文件数据
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Dim arr, brr(1 To 10000, 1 To 6)
   
5.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
6.     p = ThisWorkbook.Path
   
7.     f = p & "\系统查询结果.txt"
   
8.     Set wb = Workbooks.Open(f, 0)
   
9.     With wb.Sheets(1)
   
10.         arr = .UsedRange
    
11.         wb.Close False
    
12.     End With
    
13.     On Error Resume Next
    
14.     For i = 1 To UBound(arr)
    
15.         If InStr(arr(i, 1), "网元 : ") Then k = k + 1: d(k) = i
    
16.     Next
    
17.     For k = 1 To d.Count
    
18.         r1 = d(k)
    
19.         If k = d.Count Then r2 = r Else r2 = d(k + 1) - 1
    
20.         st = Mid(arr(r1, 1), 6)
    
21.         For i = r1 To r2
    
22.             If Left(arr(i, 1), 1) = "0" Then
    
23.                 s = WorksheetFunction.Trim(arr(i, 1))
    
24.                 b = Split(s)
    
25.                 m = m + 1
    
26.                 brr(m, 1) = st
    
27.                 For j = 0 To UBound(b)
    
28.                     brr(m, j + 2) = b(j)
    
29.                 Next
    
30.             End If
    
31.         Next
    
32.     Next
    
33.     With sh
    
34.         .UsedRange.Offset(1).Clear
    
35.         If m > 0 Then
    
36.             .[a1].Resize(1, 6).Interior.Color = 49407
    
37.             With .[a2].Resize(m, 6)
    
38.                 .Value = brr
    
39.                 .Borders.LineStyle = 1
    
40.                 .HorizontalAlignment = xlCenter
    
41.                 .VerticalAlignment = xlCenter
    
42.             End With
    
43.         End If
    
44.     End With
    
45.     Application.ScreenUpdating = True
    
46.     MsgBox "OK！"
    
47. End Sub
    

复制代码

cnmlgb9998

借楼练一下PQ。


因为你源数据，有两种格式！所以不完美。

如下图所示！

gwjkkkkk

Option Explicit
Sub TEST()
    Dim Items As FileDialogSelectedItems, strPath$, strName$
    Dim strResult$(), ar, br, y&, x&, r&, j&, n As Byte
   
    strPath = ThisWorkbook.Path & "\"
    With Application.FileDialog(1)
        With .Filters
            .Clear
            .Add "文本文件(txt)", "*.txt"
        End With
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show Then Set Items = .SelectedItems Else Exit Sub
    End With
   
    Application.ScreenUpdating = False
   
    n = FreeFile
    Open Items(1) For Input As #n
        ar = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
    Close #n
   
    r = 0
    ReDim strResult(1 To 10 ^ 4, 1 To 6)
    For y = 0 To UBound(ar)
        If InStr(ar(y), "网元 :") Then strName = Split(ar(y), "网元 :")(1)
        If InStr(ar(y), "NULL ") Then
            r = r + 1
            strResult(r, 1) = strName
            br = Split(ar(y))
            n = 1
            For j = 0 To UBound(br)
                If Len(br(j)) Then
                   n = n + 1
                   strResult(r, n) = br(j)
                End If
            Next j
        End If
    Next y
   
    [A1].CurrentRegion.Offset(1).Clear
    With [A2].Resize(r, UBound(strResult, 2))
        .Value = strResult
    End With
   
    Set Items = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

松野

ykcbf1100 发表于 2024-6-27 18:44
提取TXT文件中指定数据

完美解决，为啥我最多只能填2分

飞天篮球猪

松野 发表于 2024-6-28 11:31
完美解决，为啥我最多只能填2分

完美吗？ 数据行数多了没？

松野

gwjkkkkk 发表于 2024-6-27 19:37
Option Explicit
Sub TEST()
    Dim Items As FileDialogSelectedItems, strPath$, strName$

有个瑕疵，网元 : 福州闽清-闽清高铁火车站indoor-HLS，像这个丢了，这个格式有点不大一样

松野

ykcbf1100 发表于 2024-6-27 18:44
提取TXT文件中指定数据

刚才没发现，每个网元的最后一行多了一行

松野

飞天篮球猪 发表于 2024-6-28 11:35
完美吗？ 数据行数多了没？

是的，每个最后一行多了一行

celexcel2017

gwjkkkkk 发表于 2024-6-27 19:37
Option Explicit
Sub TEST()
    Dim Items As FileDialogSelectedItems, strPath$, strName$

有个不规则的数据，没有提取出来，结果个数=1
网元 : 福州闽清-闽清高铁火车站indoor-HLS
报文 : +++    福州闽清-闽清高铁火车站indoor-HLS        2024-06-26 10:01:36
O&M    #20478
%%/*2002763994 MML Session=1719367295*/DSP RRU:;%%
RETCODE = 0  执行成功
查询RRU/RFU动态信息
-------------------
            柜号  =  0
            框号  =  60
            槽号  =  0
        接入方向  =  从链/环头接入
维护链路工作模式  =  NULL
(结果个数 = 1)