[已解决]求助：关于 间隔提取文本。

studystudy

。。谢谢

版主老师  国庆快乐。{:011:}

fjmxwrs

回复 studystudy 的帖子

1. 
   
2. Sub Tqss()
   
3. Dim arr(), x&, i&, j&, len_arr&
   
4. Dim LineString As String
   
5. Dim iFileNumber As Integer 'File number
   
6. Dim openFileName, inputFileName As String
   
7. iFileNumber = FreeFile '获得一个没有被使用过的文件编号
   
8. openFileName = ThisWorkbook.Path & "\test.txt"
   
9. Open openFileName For Input As #iFileNumber '打开文本文件
   
10. len_arr = 1
    
11. Do While Not EOF(1) '只要没有到文件末尾，就在文本文件内循环
    
12. Line Input #1, LineString '读取文本文件一行数据
    
13. LineString = Replace(LineString, " ", "") '用replace函数把" "处理掉
    
14. ReDim Preserve arr(1 To (len_arr))
    
15. arr(len_arr) = LineString
    
16. len_arr = len_arr + 1
    
17. Loop
    
18. Close #iFileNumber '关闭文件
    
19. inputFileName = ThisWorkbook.Path & "\result.txt"
    
20. Open inputFileName For Output As #iFileNumber '创建新的文件或者覆盖已经存在的文件
    
21. With Sheet1
    
22. i = [a1] + 1
    
23. j = [b1]
    
24. For x = UBound(arr) To 1 Step -i
    
25. j1 = j1 + 1
    
26. If j1 <= j Then
    
27. Print #iFileNumber, arr(x)
    
28. End If
    
29. Next x
    
30. End With
    
31. Close #iFileNumber '关闭文件
    
32. End Sub
    

复制代码

help_1001.zip (11.93 KB, 下载次数: 2)

2011-10-3 22:58 上传

点击文件名下载附件