[已解决]提取txt文件中值

feihe

各位大大帮帮忙， 我有一个txt文件
提取文档的指定内容到 excel文内。 格式如下：


请老师帮忙看看，该怎么实现这种需求。先谢谢了
33.zip (8.86 KB, 下载次数: 21)

2016-12-25 10:29 上传

点击文件名下载附件
附件

最佳答案

月排行榜 / 总排行榜

wanao2008

2016-12-26 19:41

请测试：

1. Sub wanao()
   
2.     Dim txtLine, FileObj, TextObj, FilePath
   
3.     Dim x As Integer
   
4.     Set FileObj = CreateObject("Scripting.FileSystemObject")
   
5.     FilePath = ThisWorkbook.Path & "\33.txt"
   
6.     Set TextObj = FileObj.OpenTextFile(FilePath, 1, True)
   
7.     x = Cells(Rows.Count, "a").End(xlUp).Row
   
8.     Do While Not TextObj.AtEndOfStream
   
9.         txtLine = Trim(TextObj.readline)
   
10.         If InStr(txtLine, "interface") Then
    
11.             x = x + 1
    
12.             Cells(x, 1) = x - 1
    
13.             Cells(x, "c") = "'" & Replace(txtLine, "interface GigabitEthernet", "")
    
14.         End If
    
15.         If InStr(txtLine, "eth-trunk") Then
    
16.             Cells(x, "d") = txtLine
    
17.         End If
    
18.         If InStr(txtLine, "description") Then
    
19.             Cells(x, "i") = Trim(Replace(txtLine, "description", ""))
    
20.         End If
    
21.         If InStr(txtLine, "shutdown") Then
    
22.             Cells(x, "e") = txtLine
    
23.         End If
    
24.     Loop
    
25.     Set TextObj = Nothing
    
26.     Set FileObj = Nothing
    
27. End Sub

复制代码

跳转到最佳答案楼层

wanao2008

请测试：

1. Sub wanao()
   
2.     Dim txtLine, FileObj, TextObj, FilePath
   
3.     Dim x As Integer
   
4.     Set FileObj = CreateObject("Scripting.FileSystemObject")
   
5.     FilePath = ThisWorkbook.Path & "\33.txt"
   
6.     Set TextObj = FileObj.OpenTextFile(FilePath, 1, True)
   
7.     x = Cells(Rows.Count, "a").End(xlUp).Row
   
8.     Do While Not TextObj.AtEndOfStream
   
9.         txtLine = Trim(TextObj.readline)
   
10.         If InStr(txtLine, "interface") Then
    
11.             x = x + 1
    
12.             Cells(x, 1) = x - 1
    
13.             Cells(x, "c") = Replace(txtLine, "interface GigabitEthernet", "")
    
14.         End If
    
15.         If InStr(txtLine, "eth-trunk") Then
    
16.             Cells(x, "d") = txtLine
    
17.         End If
    
18.         If InStr(txtLine, "description") Then
    
19.             Cells(x, "i") = Trim(Replace(txtLine, "description", ""))
    
20.         End If
    
21.     Loop
    
22.     Set TextObj = Nothing
    
23.     Set FileObj = Nothing
    
24. End Sub
    

复制代码

feihe

非常好呀。 谢谢 wanao2008  如果有注释就好了

feihe

还有一个小瑕疵

wanao2008

请测试：

1. Sub wanao()
   
2.     Dim txtLine, FileObj, TextObj, FilePath
   
3.     Dim x As Integer
   
4.     Set FileObj = CreateObject("Scripting.FileSystemObject")
   
5.     FilePath = ThisWorkbook.Path & "\33.txt"
   
6.     Set TextObj = FileObj.OpenTextFile(FilePath, 1, True)
   
7.     x = Cells(Rows.Count, "a").End(xlUp).Row
   
8.     Do While Not TextObj.AtEndOfStream
   
9.         txtLine = Trim(TextObj.readline)
   
10.         If InStr(txtLine, "interface") Then
    
11.             x = x + 1
    
12.             Cells(x, 1) = x - 1
    
13.             Cells(x, "c") = "'" & Replace(txtLine, "interface GigabitEthernet", "")
    
14.         End If
    
15.         If InStr(txtLine, "eth-trunk") Then
    
16.             Cells(x, "d") = txtLine
    
17.         End If
    
18.         If InStr(txtLine, "description") Then
    
19.             Cells(x, "i") = Trim(Replace(txtLine, "description", ""))
    
20.         End If
    
21.         If InStr(txtLine, "shutdown") Then
    
22.             Cells(x, "e") = txtLine
    
23.         End If
    
24.     Loop
    
25.     Set TextObj = Nothing
    
26.     Set FileObj = Nothing
    
27. End Sub

复制代码