vba如何批量读取TXT中指定的字符到excel指定的单元格

leha001

表格实例

如上面所示，我文件夹内有N多个文本，需要循坏读取所有文本文档内相应的信息到相应的表格中，求助各位大神给写个代码，谢谢！

看见星光

Sub Clltxt()
    Dim p$, f$, fso As Object, Txt As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    r = Array("sysname", "Comware Software,", "uptime is", "CPU usage:", "Used Rate:")
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.txt")
    ReDim arr(1 To 5000, 1 To 5)
    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)
                If i <> 3 Then
                    arr(k, i + 1) = sr(0)
                Else
                    arr(k, i + 1) = sr(1) & vbCrLf & sr(2) & vbCrLf & sr(3)
                End If
            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

看见星光

date.rar (20.43 KB, 下载次数: 49)

2018-3-12 11:59 上传

点击文件名下载附件

leha001

看见星光 发表于 2018-3-12 11:59

非常感谢大神的帮助！万分感谢！！

leha001

看见星光 发表于 2018-3-12 11:58
Sub Clltxt()
    Dim p$, f$, fso As Object, Txt As Object
    Set fso = CreateObject("Scripting.Fi ...

大神，我还有一点疑问，我看了一下你写的循环语句。
                If i <> 3 Then
                    arr(k, i + 1) = sr(0)
                Else
                    arr(k, i + 1) = sr(1) & vbCrLf & sr(2) & vbCrLf & sr(3)

这个的意思应该是CPU利用率输出关键字下面的三行，如果我有一个需要输入的信息行数不确定，但是这段信息结束有一个特殊的字符串“end”,（可能表述的不清楚，以CPU利用率为例，目前是三行，但是有的设备不止三行，我想让他在读取到“end”这个结束字符后{这时候1设备可能是三行、2设备可能是5行}再写入指定的单元格）这个代码应该如何写？请大神指教，谢谢。

看见星光

leha001 发表于 2018-3-13 11:13
大神，我还有一点疑问，我看了一下你写的循环语句。
                If i  3 Then
                   ...

else 后面那句改成：
arr(k, i + 1) = split(ar(1),"end")(0)
end是结束的关键词。

紫川文秀

1. Public Sub tt()
   
2.     Dim fso As Object, fp$, ts As Object, fl As Object, str$, arr(1 To 1, 1 To 5)
   
3.     Dim reg As Object, i&, brr(1 To 5), n&
   
4.     With Application.FileDialog(msoFileDialogFolderPicker)
   
5.         If .Show Then
   
6.             fp = .SelectedItems(1)
   
7.         Else
   
8.             Exit Sub
   
9.         End If
   
10.     End With
    
11.     If Right(fp, 1) <> "" Then fp = fp & ""
    
12.     Set fso = CreateObject("scripting.filesystemobject")
    
13.     Set reg = CreateObject("vbscript.regexp")
    
14.     ActiveSheet.UsedRange.Offset(1, 0).Clear
    
15.     brr(1) = "sysname .+"
    
16.     brr(2) = "Comware Software, .+"
    
17.     brr(3) = "uptime is .+"
    
18.     brr(4) = "CPU usage:\r\n.+\r\n.+\r\n.+"
    
19.     brr(5) = "Used Rate: .+"
    
20.     For Each fl In fso.getfolder(fp).Files
    
21.         If fso.getextensionname(fl) = "txt" Then
    
22.             Set ts = fl.openastextstream(1)
    
23.             str = ts.readall
    
24.             ts.Close
    
25.             For i = 1 To 5
    
26.                 reg.Pattern = brr(i)
    
27.                 If reg.test(str) Then
    
28.                     arr(1, i) = reg.Execute(str)(0)
    
29.                 Else
    
30.                     arr(1, i) = ""
    
31.                 End If
    
32.             Next
    
33.             n = ActiveSheet.UsedRange.Rows.Count + 1
    
34.             ActiveSheet.Range("A" & n).Resize(1, 5).Value = arr
    
35.         End If
    
36.     Next
    
37.     brr(1) = "sysname "
    
38.     brr(2) = "Comware Software, "
    
39.     brr(3) = "uptime is "
    
40.     brr(4) = "CPU usage:" & Chr(13) & Chr(10)
    
41.     brr(5) = "Used Rate: "
    
42.     For i = 1 To 5
    
43.         ActiveSheet.UsedRange.Replace brr(i), ""
    
44.     Next
    
45.     ActiveSheet.UsedRange.EntireRow.AutoFit
    
46. End Sub

复制代码

紫川文秀

开始没上传附件

leha001

紫川文秀 发表于 2018-3-13 16:33
开始没上传附件

感谢大神，对我很有帮助，谢谢！！！

leha001

看见星光 发表于 2018-3-13 11:19
else 后面那句改成：
arr(k, i + 1) = split(ar(1),"end")(0)
end是结束的关键词。

首先，非常感谢大神的帮助，还得再麻烦一下大神，按照您告诉的方法我测试了一下，但是个别的还是有点问题，我在想，我每个信息收集到后都会有一个<设备名称>的标识，这个设备名称就是之前命令里面r = Array("sysname", "Comware Software,", "uptime is", "CPU usage:", "dis memory", "dis fan", "dis power", "  dis clock", "Clock status:")
这里面定义的"sysname"，然后我仿照您给的语句，else后面的写成了arr(k, i + 1) = Split(ar(1), vbCrLf & "<" & r(0) & ">")(0)

但是实际情况是读到了这一行之后未终止，表格里面多了很多行，所以不明白那里错了，请大神指点，谢谢。

下面图片是两种不同厂商型号的设备，每条搜集信息的命令执行后，会显示设备名称+某个字符，我怎么样以这个“设备名称+特殊字符”为终止（这个“设备名称+特殊字符”就类似于我之前提到的那个“end”字符）。

思科