[已解决]提取TXT指定内容到表格

skiss10086 · 发表于 2017-7-3 20:19

求：提取文本中指定内容到B列，A列提取对应的文本编号。

最佳答案

爱疯

2017-7-4 10:54

Sub test()
Dim p, f
Rows("2:65536") = ""
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.txt")
Do While f <> ""
      Call ReadText(p, f)
      f = Dir
Loop
End Sub

Sub ReadText(p, f)
Dim str$, i, A()
Open p & f For Input As #1
f = Split(f, ".")(0)
Do While Not EOF(1)
      '读入一行数据并将其赋予变量str
      Line Input #1, str
      i = i + 1
      ReDim Preserve A(1 To 2, 1 To i)
      A(1, i) = CInt(f)
      A(2, i) = Left(str, 29)
Loop
Close #1
A = Application.Transpose(A)
[A65536].End(xlUp).Offset(1, 0).Resize(UBound(A), UBound(A, 2)) = A
End Sub

aa.rar (11.75 KB, 下载次数: 12)

爱疯 · 发表于 2017-7-4 09:31

Sub test()
Dim p, f, n
Rows("2:65536") = ""
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.txt")
Do While f <> ""
      n = n + 1
      Call ReadText(p, f, n)
      f = Dir
Loop
End Sub

Sub ReadText(p, f, n)
Dim str$, i, A()
Open p & f For Input As #1
Do While Not EOF(1)
      '读入一行数据并将其赋予变量str
      Line Input #1, str
      i = i + 1
      ReDim Preserve A(1 To 2, 1 To i)
      A(1, i) = n
      A(2, i) = Left(str, 29)
Loop
Close #1
A = Application.Transpose(A)
[A65536].End(xlUp).Offset(1, 0).Resize(UBound(A), UBound(A, 2)) = A
End Sub

A.rar (13.94 KB, 下载次数: 5)

爱疯 · 发表于 2017-7-4 10:54

Sub test()
Dim p, f
Rows("2:65536") = ""
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.txt")
Do While f <> ""
      Call ReadText(p, f)
      f = Dir
Loop
End Sub

Sub ReadText(p, f)
Dim str$, i, A()
Open p & f For Input As #1
f = Split(f, ".")(0)
Do While Not EOF(1)
      '读入一行数据并将其赋予变量str
      Line Input #1, str
      i = i + 1
      ReDim Preserve A(1 To 2, 1 To i)
      A(1, i) = CInt(f)
      A(2, i) = Left(str, 29)
Loop
Close #1
A = Application.Transpose(A)
[A65536].End(xlUp).Offset(1, 0).Resize(UBound(A), UBound(A, 2)) = A
End Sub

aa.rar (11.75 KB, 下载次数: 12)

skiss10086 · 发表于 2017-7-4 12:34

爱疯发表于 2017-7-4 10:54
Sub test()
Dim p, f
Rows("2:65536") = ""

谢谢，“爱疯”老师。

		自动登录	找回密码
密码			注册

[已解决]提取TXT指定内容到表格

评分