[已解决]写VBA代码实现提取文本文档的内容

oubaiyas122

论坛老师：
              您们好！
              后学需要将在附件中的文本文档提取相应的内容到EXCEL里，效果同附件中EXCEL的形式。请各位看看怎么写代码为好，谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2014-6-5 22:27

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr(), i&, zf$
   
4. Open ThisWorkbook.Path & "\附件.txt" For Input As #1
   
5.     w = Split(StrConv(InputB(LOF(1), #1), vbUnicode), "---    END")
   
6. Close #1
   
7. ReDim arr(1 To UBound(w), 1 To 2)
   
8. For i = 0 To UBound(w) - 1
   
9.     zf = Split(Split(w(i), "IY=")(1), ",")(0)
   
10.     arr(i + 1, 1) = Mid(zf, 2, Len(zf) - 2)
    
11.     arr(i + 1, 2) = Split(Split(w(i), " 产品类型  = ")(1), vbCrLf)(0)
    
12. Next
    
13. Range("a2").Resize(UBound(arr), 2) = arr
    
14. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr(), i&, zf$
   
4. Open ThisWorkbook.Path & "\附件.txt" For Input As #1
   
5.     w = Split(StrConv(InputB(LOF(1), #1), vbUnicode), "---    END")
   
6. Close #1
   
7. ReDim arr(1 To UBound(w), 1 To 2)
   
8. For i = 0 To UBound(w) - 1
   
9.     zf = Split(Split(w(i), "IY=")(1), ",")(0)
   
10.     arr(i + 1, 1) = Mid(zf, 2, Len(zf) - 2)
    
11.     arr(i + 1, 2) = Split(Split(w(i), " 产品类型  = ")(1), vbCrLf)(0)
    
12. Next
    
13. Range("a2").Resize(UBound(arr), 2) = arr
    
14. End Sub
    

复制代码

dsmch

………………

oubaiyas122

dsmch老师的代码非常完美，非常感谢！之前用select case语句来执行，总是不能同时取到A列和与之对应的B列。
引号里面的东西一直不知道怎么取，用mid函数也不能取得很合适。
dsmch老师，能否把每句代码解释下？还有整个代码思路是怎样的，没太懂。
谢谢！