[已解决]提取文本值

qing33670000

请问在文本文件中提取值到指定EXCEL中，应如何提取？如附件！

最佳答案

月排行榜 / 总排行榜

放浪形骸

2011-7-26 23:22

修改下，结果出现在SHEET1里

1. Sub ReadFile()
   
2. Dim iFile As Integer
   
3. iFile = FreeFile
   
4. Dim sLine As String
   
5. Dim iRow As Integer
   
6. Sheet1.Cells(1, 2) = "TOTNSUB"
   
7. Sheet1.Cells(1, 3) = "TOTNSUBA"
   
8. iRow = 1
   
9. Open ThisWorkbook.Path & "\文本.TXT" For Input As iFile
   
10. While Not EOF(iFile)
    
11.     Line Input #iFile, sLine
    
12.     sLine = Trim(sLine)
    
13.     If Left(sLine, 3) = "eaw" Then
    
14.         iRow = iRow + 1
    
15.         Sheet1.Cells(iRow, 1) = Right(sLine, Len(sLine) - 4)
    
16.     ElseIf sLine = "TOTNSUB" Then
    
17.         Line Input #iFile, sLine
    
18.         Sheet1.Cells(iRow, 2) = sLine
    
19.     ElseIf sLine = "TOTNSUBA" Then
    
20.         Line Input #iFile, sLine
    
21.         Sheet1.Cells(iRow, 3) = sLine
    
22.     End If
    
23. Wend
    
24. Close iFile
    
25. End Sub

复制代码

跳转到最佳答案楼层

macky591

看看什么问题

放浪形骸

其实是没看明白这个文本的东西
好像是什么统计软件的代码？
不过按照你给的这样的格式，应该是可以弄出来的
等下，上代码

qing33670000

回复 放浪形骸 的帖子

就是要查找文本中的TOTNSUB和TOTNSUBA的值，提取到EXCEL中，还有要提取eaw CQGS04中的CQGSXX，EXCEL中就是想要的结果

放浪形骸

1. Sub ReadFile()
   
2. Dim iFile As Integer
   
3. iFile = FreeFile
   
4. Dim sLine As String
   
5. Dim iRow As Integer
   
6. Sheet2.Cells(1, 2) = "TOTNSUB"
   
7. Sheet2.Cells(1, 3) = "TOTNSUBA"
   
8. iRow = 1
   
9. Open ThisWorkbook.Path & "\文本.TXT" For Input As iFile
   
10. While Not EOF(iFile)
    
11.     Line Input #iFile, sLine
    
12.     sLine = Trim(sLine)
    
13.     If Left(sLine, 3) = "eaw" Then
    
14.         iRow = iRow + 1
    
15.         Sheet2.Cells(iRow, 1) = Right(sLine, Len(sLine) - 4)
    
16.     ElseIf sLine = "TOTNSUB" Then
    
17.         Line Input #iFile, sLine
    
18.         Sheet2.Cells(iRow, 2) = sLine
    
19.     ElseIf sLine = "TOTNSUBA" Then
    
20.         Line Input #iFile, sLine
    
21.         Sheet2.Cells(iRow, 3) = sLine
    
22.     End If
    
23. Wend
    
24. Close iFile
    
25. End Sub

复制代码

如果需要求出的都是TOTNSUB和TOTNSUBA这两项的话，就可以用这个搞定了。
其中数据的“文本.txt”要和EXCEL文件在同一目录里

放浪形骸

qing33670000 发表于 2011-7-26 22:46
回复 放浪形骸 的帖子

就是要查找文本中的TOTNSUB和TOTNSUBA的值，提取到EXCEL中，还有要提取eaw CQGS04中 ...

搞定了。你看下

qing33670000

回复 放浪形骸 的帖子

怎么我把你的代码输入到VBE中执行，没有反应的？

放浪形骸

qing33670000 发表于 2011-7-26 23:10
回复 放浪形骸 的帖子

怎么我把你的代码输入到VBE中执行，没有反应的？

你看下，结果应该是出现在了SHEET2里。。

放浪形骸

修改下，结果出现在SHEET1里

1. Sub ReadFile()
   
2. Dim iFile As Integer
   
3. iFile = FreeFile
   
4. Dim sLine As String
   
5. Dim iRow As Integer
   
6. Sheet1.Cells(1, 2) = "TOTNSUB"
   
7. Sheet1.Cells(1, 3) = "TOTNSUBA"
   
8. iRow = 1
   
9. Open ThisWorkbook.Path & "\文本.TXT" For Input As iFile
   
10. While Not EOF(iFile)
    
11.     Line Input #iFile, sLine
    
12.     sLine = Trim(sLine)
    
13.     If Left(sLine, 3) = "eaw" Then
    
14.         iRow = iRow + 1
    
15.         Sheet1.Cells(iRow, 1) = Right(sLine, Len(sLine) - 4)
    
16.     ElseIf sLine = "TOTNSUB" Then
    
17.         Line Input #iFile, sLine
    
18.         Sheet1.Cells(iRow, 2) = sLine
    
19.     ElseIf sLine = "TOTNSUBA" Then
    
20.         Line Input #iFile, sLine
    
21.         Sheet1.Cells(iRow, 3) = sLine
    
22.     End If
    
23. Wend
    
24. Close iFile
    
25. End Sub

复制代码

qing33670000

回复 放浪形骸 的帖子

嗯，看到了，非常感谢！