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

studystudy

附件： help_1001.rar (2.27 KB, 下载次数: 27)

2011-10-1 10:29 上传

点击文件名下载附件

如图：



A1=3；这里3的意思就是 间隔3行。
B1=2；这里2的意思就是 只取2次，若不够取两次，只取一次。

要实现的功能如下：

从末行往上取：最后的结果写入 result.txt

result.txt的内容如下
493
8009

···
第2个例子。



A1=1
B1=3
那么结果就是

0200
77001
8009

请求老师们帮忙。
最后祝各位老师 国庆快乐。

最佳答案

月排行榜 / 总排行榜

爱疯

2011-10-2 00:44

按第10行的规则，有填充色的单元格是结果。

按I10的规则，结果应是77001,6302。而1楼要求的结果是错的（493,809，这是2,2规则才的结果）

同时我也改了下，觉得这次应该好了吧
{:301:}

1. 
   
2. Sub tiqu()
   
3.     Dim p As String, arr() As String, arr2() As String
   
4.     Dim i As Long, s As Integer, jg As Integer, cs As Integer
   
5.     jg = Range("a1")    '间隔
   
6.     cs = Range("b1")    '次数
   
7.     p = ThisWorkbook.Path
   
8.     Open p & "\test.txt" For Input As #1
   
9.     arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
   
10.     Close #1
    
11.     ReDim arr2(1 To UBound(arr))
    
12.     i = UBound(arr)
    
13. 
    
14.     Do Until s = cs
    
15.         If i > jg Then
    
16.             s = s + 1
    
17.             If s = 1 Then
    
18.                 i = i - jg    '第1次移动
    
19.             Else
    
20.                 i = i - jg - 1    '不是第1次移动
    
21.             End If
    
22.             arr2(s) = arr(i)
    
23.         Else
    
24.             Exit Do
    
25.         End If
    
26.     Loop
    
27. 
    
28.     Open p & "\result.txt" For Output As #1
    
29.     For i = 1 To s
    
30.         Print #1, arr2(i)
    
31.     Next i
    
32.     Close #1
    
33. End Sub

复制代码

help_1001(1).rar (19.01 KB, 下载次数: 26)

2011-10-2 00:40 上传

点击文件名下载附件

跳转到最佳答案楼层

上清宫主

对于txt文件，不晓得readline可不可以从后往前读、或者指定读取第几行。
如果不行，对于较小的txt文件可用readall一次性读出来再取需要的。
不过还是建议使用其它来读取，如使用word、excel等来打开txt文件后，再控制读取所需要的

爱疯

1. 
   
2. Sub tiqu()
   
3.     Dim p As String, arr() As String, arr2() As String
   
4.     Dim i As Long, s As Integer, jg As Integer, cs As Integer
   
5. 
   
6.     jg = Range("a1")    '间隔
   
7.     cs = Range("b1")    '次数
   
8.     p = ThisWorkbook.Path
   
9.     Open p & "\test.txt" For Input As #1
   
10.     arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    
11.     Close #1
    
12.     ReDim arr2(1 To UBound(arr))
    
13.     i = UBound(arr)
    
14. 
    
15.     Do While s < cs
    
16.         If i > jg - 1 Then
    
17.             s = s + 1
    
18.             If jg = 1 Then
    
19.                 i = i - 1    '移动方法1
    
20.             Else
    
21.                 i = i - jg + 1    '移动方法2
    
22.             End If
    
23.             arr2(s) = arr(i)
    
24.             i = i - 1
    
25.         End If
    
26.     Loop
    
27. 
    
28.     Open p & "\result.txt" For Output As #1
    
29.     For i = 1 To s
    
30.         Print #1, arr2(i)
    
31.     Next i
    
32.     Close #1
    
33. End Sub

复制代码

不知可以不{:041:}

fjmxwrs

学习文本文件的提取方法

studystudy

爱疯 发表于 2011-10-1 11:39
不知可以不

测试 A1=3 B1=3时。

表格卡死。。。

不知道哪里的原因。。

请 版主 老师 再看看。谢谢

studystudy

发现。。。若是 test.txt 的 内容  不能满足 提取 参数的 话 表格会卡死。。

爱疯

studystudy 发表于 2011-10-1 19:34
发现。。。若是 test.txt 的 内容  不能满足 提取 参数的 话 表格会卡死。。

1. 
   
2. Sub tiqu()
   
3.     Dim p As String, arr() As String, arr2() As String
   
4.     Dim i As Long, s As Integer, jg As Integer, cs As Integer
   
5. 
   
6.     jg = Range("a1")    '间隔
   
7.     cs = Range("b1")    '次数
   
8.     p = ThisWorkbook.Path
   
9.     Open p & "\test.txt" For Input As #1
   
10.     arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    
11.     Close #1
    
12.     ReDim arr2(1 To UBound(arr))
    
13.     i = UBound(arr)
    
14. 
    
15.     Do Until s = cs
    
16.         If i > jg - 1 Then
    
17.             s = s + 1
    
18.             If jg = 1 Then
    
19.                 i = i - 1    '移动方法1
    
20.             Else
    
21.                 i = i - jg + 1    '移动方法2
    
22.             End If
    
23.             arr2(s) = arr(i)
    
24.             i = i - 1
    
25.         Else
    
26.             Exit Do
    
27.         End If
    
28.     Loop
    
29. 
    
30.     Open p & "\result.txt" For Output As #1
    
31.     For i = 1 To s
    
32.         Print #1, arr2(i)
    
33.     Next i
    
34.     Close #1
    
35. End Sub

复制代码

是我没想好，改了，再呢{:011:}

studystudy

老师好。

代码好像还有点BUG，，，


A1=1,B1=5.

可以得到正确结果。

0200
77001
8009
6302


当我改成

A1=2,B1=5时。。

得到结果

0200
77001
8009
6302

明显错误了。

正确的应该是：


493
8009
351

studystudy

请版主 老师 再检查一下。

谢谢

爱疯

按第10行的规则，有填充色的单元格是结果。

按I10的规则，结果应是77001,6302。而1楼要求的结果是错的（493,809，这是2,2规则才的结果）

同时我也改了下，觉得这次应该好了吧
{:301:}

1. 
   
2. Sub tiqu()
   
3.     Dim p As String, arr() As String, arr2() As String
   
4.     Dim i As Long, s As Integer, jg As Integer, cs As Integer
   
5.     jg = Range("a1")    '间隔
   
6.     cs = Range("b1")    '次数
   
7.     p = ThisWorkbook.Path
   
8.     Open p & "\test.txt" For Input As #1
   
9.     arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
   
10.     Close #1
    
11.     ReDim arr2(1 To UBound(arr))
    
12.     i = UBound(arr)
    
13. 
    
14.     Do Until s = cs
    
15.         If i > jg Then
    
16.             s = s + 1
    
17.             If s = 1 Then
    
18.                 i = i - jg    '第1次移动
    
19.             Else
    
20.                 i = i - jg - 1    '不是第1次移动
    
21.             End If
    
22.             arr2(s) = arr(i)
    
23.         Else
    
24.             Exit Do
    
25.         End If
    
26.     Loop
    
27. 
    
28.     Open p & "\result.txt" For Output As #1
    
29.     For i = 1 To s
    
30.         Print #1, arr2(i)
    
31.     Next i
    
32.     Close #1
    
33. End Sub

复制代码

help_1001(1).rar (19.01 KB, 下载次数: 26)

2011-10-2 00:40 上传

点击文件名下载附件