一次导入多个txt文档

ymsh1234

         打开以“自选”为开头的txt文件，由于这些文档都是其他系统里面导出的，所以TXT会出现乱码，因此建议使用空格来作为每个单元格的分割线。然后对每个单元格做一个字符判断-有意义的字符通常是以SH、SZ开始，以空格结束。
         希望有高手看看！

liulang0808

使用fso或者dir遍历文件，判断文件类型及左侧两个文件名字符是什么
然后通过正则表达式提取数据
以上建议供楼主参考

ymsh1234

       能否写一下代码，我自己是一个新手，一开始是想自己独立完成，所以最近几天一直在参考别人已经写好的一些代码（导入txt文档），不过老是有问题。这才提出来想请高手看看。
      

一把小刀闯天下

Option Explicit

Sub test()
  Dim i, filename(), brr, maxrow, arr, j, n
  If Not getfilename(filename, ThisWorkbook.Path, ".txt") Then MsgBox "!": Exit Sub
  ReDim brr(1 To 16 ^ 4, 1 To UBound(filename))
  For i = 1 To UBound(filename)
    Open filename(i) For Input As #1
    arr = StrConv(InputB(LOF(1), 1), vbUnicode)
    Close #1
    arr = Replace(Replace(arr, "SH", "|s"), "SZ", "|z")
    arr = Split(arr, "|"): n = n + 1
    If maxrow < UBound(arr) Then maxrow = UBound(arr)
    For j = 1 To UBound(arr)
      brr(j, n) = Split(arr(j))(0)
      brr(j, n) = IIf(Left(brr(j, n), 1) = "s", "SH", "SZ") & Right(brr(j, n), Len(brr(j, n)) - 1)
  Next j, i
  With [a2]
    .Resize(maxrow + 1, n + 1).ClearContents
    .Resize(maxrow, n) = brr
  End With
End Sub

Function getfilename(filename, pth, mark) As Boolean
  Dim f, n
  If Right(pth, 1) <> "\" Then pth = pth & "\"
  f = Dir(pth & "*.*")
  Do While Len(f) > 0
    If LCase(Right(f, Len(mark))) = LCase(mark) Then
      n = n + 1: ReDim Preserve filename(1 To n)
      filename(n) = pth & f
    End If
    f = Dir
  Loop
  If n > 0 Then getfilename = True
End Function

duquancai

Sub 读取文本文件()
    Dim S$(2), arr(), mt, reg As Object, r&(1)
    S(0) = ThisWorkbook.Path: S(1) = Dir(S(0) & "\*.txt")
    Cells.ClearContents
    ReDim arr(1000, 1 To Columns.Count)
    Set reg = CreateObject("VBScript.Regexp")
    reg.Global = True: reg.Pattern = "S[HZ][^\x20]+"
    Do While S(1) <> ""
        If Left(S(1), 2) = "自选" Then
            r(0) = r(0) + 1: r(1) = 0
            arr(0, r(0)) = Left(S(1), InStrRev(S(1), ".") - 1)
            Open S(0) & "\" & S(1) For Input As #1
            S(2) = StrConv(InputB(LOF(1), 1), vbUnicode)
            For Each mt In reg.Execute(S(2))
                r(1) = r(1) + 1
                arr(r(1), r(0)) = mt
            Next
            Close #1
        End If
        S(1) = Dir
    Loop
    Range("a1").Resize(100, 256) = arr
End Sub

ymsh1234

非常完美的实现了我的目标，真的感谢！
ps：看来我最近有的忙了--搞懂这段代码的内容。

ymsh1234

    还是有一个小问题请帮忙看看，想把文件名写在每一列的第一行，能否看看。