如何用VBA方法读取固定格式的TXT文件

wwhhpp123

请教各位专家，经常有供应商提供的下列格式的txt文件，需要提取红线处的数据形成清单
如何用VBA方法读取这种固定格式的TXT文件
谢谢
F267409.rar (2.87 KB, 下载次数: 4)

2015-1-7 12:57 上传

点击文件名下载附件
清单实例

chxw68

1. Sub test()
   
2.   Dim mypath$, myname$
   
3.   Dim r%, i%
   
4.   Dim arr, brr()
   
5.   Dim reg As New RegExp
   
6.   With reg
   
7.     .Global = True
   
8.     .Pattern = "^\d{3}\s+(\d{14}[A-Z]).*"
   
9.   End With
   
10.   mypath = ThisWorkbook.Path & ""
    
11.   If Dir(mypath & "F267409.txt") = "" Then
    
12.     MsgBox "文本文件不存在！"
    
13.     Exit Sub
    
14.   End If
    
15.   Open mypath & "F267409.txt" For Input As #1
    
16.   arr = Split(Input(LOF(1), #1), vbLf)
    
17.   Close #1
    
18.   ReDim brr(1 To UBound(arr) + 1, 1 To 1)
    
19.   m = 0
    
20.   For i = 0 To UBound(arr)
    
21.     Set mh = reg.Execute(arr(i))
    
22.     If mh.Count > 0 Then
    
23.       m = m + 1
    
24.       brr(m, 1) = mh(0).SubMatches(0)
    
25.     End If
    
26.   Next
    
27.   With Worksheets("sheet1")
    
28.     .Range("a1").Resize(UBound(brr), 1) = brr
    
29.   End With
    
30. End Sub
    

复制代码

chxw68

详见附件。

bluexuemei

1. Sub gettxt()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3.     Dim y, ojs As Object
   
4.     Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
5.     y = ojs.eval("Dir.chdir('" & ThisWorkbook.Path & "');File.readlines('F267409.txt').select{|x|x=~/^\d+\s+\d+/}.map{|x|x.scan(/^\d+\s+(\S+)/)[0]}")
   
6.     Sheet1.[a1].Resize(UBound(y) + 1) = y
   
7.     Set ojs = Nothing
   
8.     'Stop
   
9. End Sub
   

复制代码

wwhhpp123

自己也捣鼓了一个，感觉有些山寨，请各位专家赐教

Public Sub abc()
Dim filename, inputstring As String
Dim i As Integer
Dim data
i = 1
j = 1
     With Application.FileDialog(msoFileDialogFilePicker)
         If .Show = True Then
             filename = .SelectedItems(1)
         End If
     End With
'filename = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) '本列TXT文件
Open filename For Input Access Read As #1
Cells(j, 1) = "序号"
Cells(j, 2) = "MAS编码"
Cells(j, 3) = "图号"
Cells(j, 4) = "版本"

Do While Not EOF(1)
    Line Input #1, inputstring '读TXT文件一行
    data = inputstring
    If i <> 1 Then
       If IsNumeric(Left(data, 3)) Then
      
            Cells(j + 1, 1) = Left(data, 3) '截取从第11个字符后6个字符
            Cells(j + 1, 2) = Trim(Mid(data, 6, 25))
            If Left(Cells(j + 1, 2), 4) = "0371" Then
                Cells(j + 1, 3) = Mid(Cells(j + 1, 2), 5, 5) & "-" & Mid(Cells(j + 1, 2), 10, 5)
                Cells(j + 1, 4) = Mid(Cells(j + 1, 2), 15, (Len(Cells(j + 1, 2)) - 14))
            End If
            j = j + 1
       End If
    End If
i = i + 1

Loop
Close #1
End Sub

wwhhpp123

chxw68 发表于 2015-1-7 14:38
详见附件。

还是 chxw68的专业啊，用的正则表达式，学习了