如何提取多个txt文件中第2列数据，放在一个excel中

lengduo99

求各位前辈指导，如何提取如下每个txt文件中的第2列数据，形成一个新的excel（共80列），应该怎么加入代码呢？
恳求大神赐教！！！感激。

yylucke

抱歉回答错了！

liucf

Sub TXT()
  Application.ScreenUpdating = False
  p = ActiveWorkbook.Path & "/"
  Cells.Clear
  N = 1
  For Each File In CreateObject("Scripting.FilesyStemObject").GetFolder(p).Files
    If File.Name Like "*.txt" Then
      S = CreateObject("Scripting.FileSystemObject").OpenTextFile(p & File.Name, 1, False).ReadAll()
      A = Split(S, vbCrLf)
      Cells(1, N) = File.Name
      For I = 0 To UBound(A) - 1
        Cells(I + 2, N) = Val(Mid(A(I), InStr(A(I), ",") + 1))
      Next
      N = N + 1
    End If
  Next
  Application.ScreenUpdating = True
End Sub

lengduo99

liucf 发表于 2018-4-26 18:29
Sub TXT()
  Application.ScreenUpdating = False
  p = ActiveWorkbook.Path & "/"

谢谢，这个可以用的，是吧

lengduo99

lengduo99 发表于 2018-4-26 19:06
谢谢，这个可以用的，是吧

谢谢您的帮助

jjmysjg

liucf 发表于 2018-4-26 18:29
Sub TXT()
  Application.ScreenUpdating = False
  p = ActiveWorkbook.Path & "/"

请教老师，如果导入第一行，怎么修改代码？
谢谢

liucf

jjmysjg 发表于 2018-4-26 21:22
请教老师，如果导入第一行，怎么修改代码？
谢谢

去掉Cells(1, N) = File.Name
修改:Cells(I +1, N) = Val(Mid(A(I), InStr(A(I), ",") + 1))

LMY123

Sub 第2列() ''
  Application.ScreenUpdating = False
  p = ActiveWorkbook.Path & "/"
  Cells.Clear
  N = 1
  For Each File In CreateObject("Scripting.FilesyStemObject").GetFolder(p).Files
    If File.Name Like "*.txt" Then
      S = CreateObject("Scripting.FileSystemObject").OpenTextFile(p & File.Name, 1, False).ReadAll()
      A = Split(S, vbCrLf)
      Cells(1, N) = File.Name
      For I = 0 To UBound(A) - 1
        Cells(I + 2, N) = Split(A(I), ",")(1)
      Next
      N = N + 1
    End If
  Next
  Application.ScreenUpdating = True
End Sub