[已解决]文本中含有要求中汉字的，就提取这一行到EXCEL表中

wuliao_tao

0.rar (1.93 KB, 下载次数: 32)

2012-2-11 09:36 上传

点击文件名下载附件

文本中含有要求中汉字的，就提取这一行到EXCEL表中，见表样，求VBA，谢谢

最佳答案

月排行榜 / 总排行榜

爱疯

2012-2-11 10:24

1. 
   
2. Sub test()
   
3.     Dim A() As String, B(), C
   
4.     Dim i&, j&, s&
   
5.     Open ThisWorkbook.Path & "\1.txt" For Input As #1
   
6.     A = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
   
7.     Close #1
   
8.     ReDim B(1 To 66666, 0 To 9)    '预定大小，自行修改
   
9.    
   
10.     For i = LBound(A) To UBound(A)
    
11.         If InStr(A(i), "新华书店") Then
    
12.             s = s + 1
    
13.             C = Split(A(i), Chr(9))
    
14.             For j = 0 To UBound(C)
    
15.                 B(s, j) = C(j)
    
16.             Next j
    
17.         End If
    
18.     Next i
    
19.     [a2].Resize(s, UBound(B, 2)) = B
    
20. End Sub

复制代码

跳转到最佳答案楼层

TTTTT

没明白：哪是数据源，哪是提出后的样例？

wuliao_tao

TTTTT 发表于 2012-2-11 08:12
没明白：哪是数据源，哪是提出后的样例？

是我不小心把数据源搞错了，请再帮我看  一下。
0.rar (1.93 KB, 下载次数: 19)

2012-2-11 09:38 上传

点击文件名下载附件

windimi007

wuliao_tao 发表于 2012-2-11 09:38
是我不小心把数据源搞错了，请再帮我看  一下。

貌似还是原来的附件，不明白……

上清宫主

其实就是用open打开1.txt文件，用readline按行读入，用instr看读入的这行中有没有“新华书店”这四个字，有，则写进单元格,写前以空格为标识用split分一下
也可以先整体导入E中，分列，再将每行中没有“新华书店”这四个字的行删除，也成

wuliao_tao

windimi007 发表于 2012-2-11 09:44
貌似还是原来的附件，不明白……

0.rar (1.96 KB, 下载次数: 16)

2012-2-11 10:01 上传

点击文件名下载附件

只要文本中有“新华书店”这四个字的，就将文本中整行数据提取到EXCEL表格中。

wuliao_tao

上清宫主 发表于 2012-2-11 10:00
其实就是用open打开1.txt文件，用readline按行读入，用instr看读入的这行中有没有“新华书店”这四个字，有 ...

当然你的方法可行，我这是一个简单的例字，如果文本中数据量较大，这种方法就不好操作了，我就是想通过VBA提取

爱疯

导入数据的列固定吗？如最多3列

砂海

问兰版,正则法 判断汉字

爱疯

1. 
   
2. Sub test()
   
3.     Dim A() As String, B(), C
   
4.     Dim i&, j&, s&
   
5.     Open ThisWorkbook.Path & "\1.txt" For Input As #1
   
6.     A = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
   
7.     Close #1
   
8.     ReDim B(1 To 66666, 0 To 9)    '预定大小，自行修改
   
9.    
   
10.     For i = LBound(A) To UBound(A)
    
11.         If InStr(A(i), "新华书店") Then
    
12.             s = s + 1
    
13.             C = Split(A(i), Chr(9))
    
14.             For j = 0 To UBound(C)
    
15.                 B(s, j) = C(j)
    
16.             Next j
    
17.         End If
    
18.     Next i
    
19.     [a2].Resize(s, UBound(B, 2)) = B
    
20. End Sub

复制代码