多列数据的文本文件中提取数据

需要从文本文件中，提取第一列的数字， vb如何操作？

 

在之前的贴子中看到下面的语句，但是无法实现多列文本中提取的功能。

Sub addall()

Application.ScreenUpdating = False

Dim arr() As String, i As Long, n As Long, b() As Byte, temp As String, lines() As String, x As Long

ReDim arr(1 To 5, 1 To 65535) '一个二维数组,4列,excel最大能有65535行,

temp = Dir([a1] & "\*.txt")

While temp > ""

n = n + 1

arr(1, n) = temp '数组(1,n)为文件名

Open [a1] & "\" & temp For Binary As #1 '使用1#通道存储打开的文件

ReDim b(LOF(1)) '取得文件长度,定义为数组的长度

Get #1, , b '读取最后的数字',将打开的文本文件读取到数组b中

Close #1 '关闭1#通道

On Error Resume Next '如果错误则跳出,改变错误陷阱

lines = Split(StrConv(b, vbUnicode), vbCrLf) '建立一个数组,数组内容为文件的内容:把文本内容按结束符加换行符分成数组，
'这样lines数组里的每一个元素就是文本文件里每一行的内容。第一行是lines(0)，第二行是lines(1)，依此类推。

arr(2, n) = lines([b1]) 'arr是个两维数组，arr(1,1)是表示第一个文件的名字，
'arr(2,1)是表示第一个文件第7行的内容，arr(3,1)是表示第一个文件第9行的内容，arr(1,1)是表示第一个文件第12行的内容，依此类推。

arr(3, n) = lines([c1])

arr(4, n) = lines([d1])

arr(5, n) = lines([e1])

temp = Dir() '令循环结束条件达到

Wend '结束循环

ReDim Preserve arr(1 To 5, 1 To n)

[a2].Resize(n, 5) = WorksheetFunction.Transpose(arr) '数组arr粘贴到表格中

Application.ScreenUpdating = True
End Sub

<ignore_js_op> avVcXIVb.rar (709 Bytes, 下载次数: 632)

 

 

 

已经上传了需要导入的文本文件。我最后需要导入8944125214963660509这个字段。