请教各位大神：如何从TXT文件中获取数据至excel表格呢？？？

qiaodong1991060

我有一大堆TXT文件-命名方式为“ 姓名+手机号”，我想在Excel文件中的 “姓名、性别、身份证号码、住址、手机号码” 所在列下  抽取相应的TXT文件数据（个别文件的文件名只有姓名并没有手机号，此项无需理会）如果都是Excel文件的话我还可以操作，但这是TXT文件顿感无措，望各路大神予以指导 , 谢谢！

3190496160

遍历打开所有txt文件，把txt文件数据赋值给数组，然后split根据分号截取数据赋值给数组，最后把数组赋值给单元格区域即可

qiaodong1991060

3190496160 发表于 2021-5-31 11:29
遍历打开所有txt文件，把txt文件数据赋值给数组，然后split根据分号截取数据赋值给数组，最后把数组赋值给 ...

Sub demo()
   [a2:g1000].ClearContents
   Set re = CreateObject("vbscript.regexp")
   Set f = CreateObject("ADODB.Stream")
   file = Dir(ThisWorkbook.Path & "\*.txt")
   r = 1
   Do Until file = ""
      With re
         .Pattern = "\d{11}.txt"
         If Not .test(file) Then GoTo 1
         i = 0: r = r + 1
         f.Charset = "utf-8": f.Open
         f.LoadFromFile ThisWorkbook.Path & "\" & file
         Do Until f.EOS
            s = Split(f.ReadText(-2), ":")
            If UBound(s) = 1 Then
               i = i + 1
               Select Case i
                  Case 1: col = 2
                  Case 2: col = 3
                  Case 5: col = 6
                  Case 6: col = 4
                  Case Else: col = 0
               End Select
               If col Then Cells(r, col) = s(1)
            End If
         Loop
         f.Close
         Cells(r, 7) = Replace(Right(file, 15), ".txt", "")
      End With
1:
      file = Dir()
   Loop
End Sub

3190496160

Sub txt到excel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim lines, cols ''定义两个数组
Dim i As Integer, j As Integer, k As Integer, q As Integer ''定义四个数值型变量
Dim fileOpenName ''定义一个文本型变量，获取文件路径和文件名称
Dim arr()
ReDim arr(1 To 10000, 1 To 9)
f = Dir(ThisWorkbook.Path & "\*.txt")
Worksheets("Sheet1").UsedRange.Offset(1).ClearContents ''清空原来的数据
Worksheets("Sheet1").Columns("g:g").NumberFormatLocal = "@" ''设置A列为文本格式
Do While f <> ""
    n = n + 1
    arr(n, 1) = n
    fileOpenName = ThisWorkbook.Path & "\" & f
    'Open fileOpenName For Input As #1 ''打开选择的文本文件
    Set wb = Workbooks.Open(fileOpenName)
    ar = wb.Worksheets(1).[a1].CurrentRegion
    'lines = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf) ''把文本文件的数据赋值给数组lines
    'k = UBound(lines) ' + 1 '文件的行数
'遍历每一行
    'Close #1 ''关闭打开的文本文件
    wb.Close False
    mc = Trim(Split(f, ".")(0))
    k = UBound(ar)
    If Len(mc) > 10 Then arr(n, 9) = Mid(mc, 4, Len(mc) - 3)
    For i = 1 To k ''循环数组行
        If InStr(ar(i, 1), ":") > 0 Then ''判断该行是否有逗号
            rr = Split(ar(i, 1), ":")(1)   '以逗号作为分隔，将每行字符分割，分隔符可根据实际情况自己修改
            arr(n, i + 1) = rr
        End If
    Next i
f = Dir
Loop
Sheet1.[a2].Resize(n, UBound(arr, 2)) = arr
MsgBox "获取了" & n & "行数据"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

3190496160

调试文件.rar (41.46 KB, 下载次数: 6)

2021-5-31 22:47 上传

点击文件名下载附件

qiaodong1991060

3190496160 发表于 2021-5-31 22:47

感谢你的帮助

yongge9999

参与一下，修正5楼中关于获取手机号时（如果姓名为2个字，手机号读取不完整）的错误。