[已解决]高难度导入TXT数据

张雄友 · 发表于 2015-3-29 06:22

本帖最后由张雄友于 2015-3-30 18:10 编辑

高难度导入TXT数据，已模拟部分，但找不到办法。

最佳答案

grf1973

2015-3-30 11:11

确实比较难，主要是大多数数据全在一行内的，只能用月份分解。看看附件是否可行。

Sub Macro1()
yf = Array("Jan.", "Feb.", "Mar.", "Apr.", "May", "June", "July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec.")
Dim arr(1 To 1000, 1 To 3)
Dim y(1000)
Open ThisWorkbook.Path & "\3月份.txt" For Input As #1
On Error Resume Next
Do While Not EOF(1)
Line Input #1, txt '读入每行
For i = 0 To UBound(yf) '月份前加分隔符
txt = Replace(txt, yf(i), "///" & yf(i))
Next
txrr = Split(txt, "///") '分隔月份
For i = 0 To UBound(txrr)
n = n + 1 '逐条录入
x = Trim(txrr(i))
y(n) = Split(x, " ")(UBound(Split(x, " "))) '最末的数值（下一条月份前的序号）
x = Left(x, Len(x) - Len(y(n))) '本条去掉最末的数值
If n = 1 Then
arr(n, 1) = x
Else
xx = y(n - 1) & " " & x
For k = 1 To 8: xx = Replace(xx, " ", " "): Next '去掉双空格
a = Split(xx, " ")
arr(n, 1) = a(0): arr(n, 2) = "'" & a(1) & " " & a(2)
arr(n, 3) = Trim(Mid(xx, Len(a(0) & a(1) & a(2)) + 3))
End If
Next
Loop
Close #1
With Sheet2
.Cells.Clear
.[a1].Resize(n, 3) = arr
.[a2].Resize(n - 1, 3).Sort key1:=.[a2]
For r = n To 2 Step -1
If .Cells(r, 2) Like "*---*" Or .Cells(r, 2) Like "*No.*" Then .Rows(r).Delete
Next
End With
End Sub

复制代码

张雄友 · 发表于 2015-3-29 17:27

顶一下。

grf1973 · 发表于 2015-3-30 11:11

确实比较难，主要是大多数数据全在一行内的，只能用月份分解。看看附件是否可行。

Sub Macro1()
yf = Array("Jan.", "Feb.", "Mar.", "Apr.", "May", "June", "July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec.")
Dim arr(1 To 1000, 1 To 3)
Dim y(1000)
Open ThisWorkbook.Path & "\3月份.txt" For Input As #1
On Error Resume Next
Do While Not EOF(1)
Line Input #1, txt '读入每行
For i = 0 To UBound(yf) '月份前加分隔符
txt = Replace(txt, yf(i), "///" & yf(i))
Next
txrr = Split(txt, "///") '分隔月份
For i = 0 To UBound(txrr)
n = n + 1 '逐条录入
x = Trim(txrr(i))
y(n) = Split(x, " ")(UBound(Split(x, " "))) '最末的数值（下一条月份前的序号）
x = Left(x, Len(x) - Len(y(n))) '本条去掉最末的数值
If n = 1 Then
arr(n, 1) = x
Else
xx = y(n - 1) & " " & x
For k = 1 To 8: xx = Replace(xx, " ", " "): Next '去掉双空格
a = Split(xx, " ")
arr(n, 1) = a(0): arr(n, 2) = "'" & a(1) & " " & a(2)
arr(n, 3) = Trim(Mid(xx, Len(a(0) & a(1) & a(2)) + 3))
End If
Next
Loop
Close #1
With Sheet2
.Cells.Clear
.[a1].Resize(n, 3) = arr
.[a2].Resize(n - 1, 3).Sort key1:=.[a2]
For r = n To 2 Step -1
If .Cells(r, 2) Like "*---*" Or .Cells(r, 2) Like "*No.*" Then .Rows(r).Delete
Next
End With
End Sub

复制代码

张雄友 · 发表于 2015-3-30 21:06

grf1973 发表于 2015-3-30 11:11
确实比较难，主要是大多数数据全在一行内的，只能用月份分解。看看附件是否可行。

不对的，第一行就不对了，参看模拟效果，第三列是很长的：

hcw_future · 发表于 2015-3-31 05:00

好高端

grf1973 · 发表于 2015-3-31 09:14

就你示例中的txt文件，实在没办法。除非pdf转txt时左右分开还有可能。

grf1973 · 发表于 2015-3-31 09:18

下面是左右列分开的。就是先选择左列文本，粘贴到Txt文件，再选择右列文本粘贴到Txt文件。这样要好处理得多。

张雄友 · 发表于 2015-3-31 18:19

grf1973 发表于 2015-3-31 09:18
下面是左右列分开的。就是先选择左列文本，粘贴到Txt文件，再选择右列文本粘贴到Txt文件。这样要好处理得多 ...

这样做当然可以，问题是：先选择左列文本，粘贴到Txt文件，再选择右列文本粘贴到Txt文件，

这个怎么做的？有动画或者步骤？

grf1973 · 发表于 2015-4-1 10:21

一般的Pdf阅读器都有选择区域和读取文本功能的

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