超大批量提取txt指定数据到Excel指定列

荔枝jjee

liu-aguang 发表于 2014-10-15 07:57
代码设计的是提取文本中最一列数据,如果数据不在最后列要修改代码.

同样的是在最后一列的其它txt还是全是38的问题，那可以设置指定第二列提取码？

liu-aguang

荔枝jjee 发表于 2014-10-15 08:31
同样的是在最后一列的其它txt还是全是38的问题，那可以设置指定第二列提取码？

上传几个出错的文本文件.

荔枝jjee

xulubang 发表于 2014-10-14 22:03
公式没这么强的功能！

那该用什么其它方法呢？

荔枝jjee

liu-aguang 发表于 2014-10-15 08:36
上传几个出错的文本文件.

我测试几次发现，对于几千行的txt不会出错，但是对于有48万行的txt会出现，运行时出错‘13’类型不匹配的提示，是不是这里两行的代码限制呢？因为大样本传不了附件。你可以把之前的文本数据扩充到几十万行，看看还能提取吗？
Sheets("sheet1").Range("a2").Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr)
    Sheets("sheet2").Range("a2").Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)

魂断蓝桥

首先要把文件名中的pxp 删除，我用的access批量重命名.

奇数，偶数分开两张表。


Option Explicit

Sub a()
Dim cnn As Object, rs As Object, SQL$, Mypath$, MyName$, arr, i, m, K As Integer
Dim brr(1 To 400, 1 To 200), cRR(1 To 400, 1 To 200), J, t As Byte
Mypath = ThisWorkbook.Path & "\"
MyName = Dir(Mypath & "*.TXT")
Application.ScreenUpdating = False
Do While MyName <> ""
    If MyName <> ThisWorkbook.Name Then
        Set cnn = CreateObject("ADODB.CONNECTION")
        cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Mypath & ";Extended Properties=""text;HDR=yes;"""
        SQL = "Select * From [" & MyName & "]"
        arr = cnn.Execute(SQL).GetRows
            If Left(MyName, InStr(MyName, ".") - 1) Mod 2 = 0 Then
                m = 1: J = J + 1
                brr(m, J) = "文件名: " & Left(MyName, InStr(MyName, ".") - 1)
                    For i = 4 To UBound(arr, 2)
                        m = m + 1
                        brr(m, J) = Mid(arr(0, i), 11)
                    Next
                Else
                    K = 1: t = t + 1
                cRR(K, t) = "文件名: " & Left(MyName, InStr(MyName, ".") - 1)
                    For i = 4 To UBound(arr, 2)
                        K = K + 1
                        cRR(K, t) = Mid(arr(0, i), 11)
                    Next
            End If

    End If
    MyName = Dir
Loop
cnn.Close: Set cnn = Nothing
Sheet1.Cells.Clear
Sheet1.[a1].Resize(400, 200) = brr
Sheet2.Cells.Clear
Sheet2.[a1].Resize(400, t) = cRR
Application.ScreenUpdating = True
End Sub

liu-aguang

荔枝jjee 发表于 2014-10-15 09:28
我测试几次发现，对于几千行的txt不会出错，但是对于有48万行的txt会出现，运行时出错‘13’类型不匹配的 ...

代码使用正则提取数据行,它的集合只能容纳65536个数据,所以超过这个数据会出错.要解决它只有改为速度慢一点的算法.
另外,必须明确:要提取的数据是不是都在文本的第二列?第二列与第一列之间的分隔符是否都是制表符?第二列是否只有要提取的数据才是数值数据?文本文件名的数值部分与其它部分是否都是用英文句点分隔?

荔枝jjee

魂断蓝桥 发表于 2014-10-15 09:41
首先要把文件名中的pxp 删除，我用的access批量重命名.

奇数，偶数分开两张表。

弱弱的问问，access批量批量重命名是指去掉pxp吗？这个代码还是在Excel中运行的吧？可不可以请你写个具体的操作步骤呢？谢谢

魂断蓝桥

ACCESS 是一个著名的看图软件，这个软件可以批量修改文件名，代码是在excel运行的。



数据及要求.rar (26.67 KB, 下载次数: 53)

2014-10-15 10:26 上传

点击文件名下载附件

荔枝jjee

liu-aguang 发表于 2014-10-15 09:54
代码使用正则提取数据行,它的集合只能容纳65536个数据,所以超过这个数据会出错.要解决它只有改为速度慢一 ...

嗯嗯，谢谢指教。可是我手工copy的是可以粘贴几十万的数据呢

荔枝jjee

魂断蓝桥 发表于 2014-10-15 10:27
ACCESS 是一个著名的看图软件，这个软件可以批量修改文件名，代码是在excel运行的。

嗯嗯，我试了提示运行错误‘9’，下标越界，方便留个邮箱吗？我发原始数据给你，试试看。这里传不了那么大的附件。