[已解决]如何用VBA将txt文件自动有序导入excel

neicezhanghao

跪求各位大神 大哥 大姐 大叔 大神 大爷 大妈 好心雷锋 帮帮忙 小弟感激不尽 跪谢！！！

【VBA实现需求】
（1）

要求1：TXT内容导入后不要删除或清楚模块1中的内容

（2）

要求2：TXT内容导入后，模块2中选中全部区域 点击
	定位条件 空值  可以找到所有空值

（3）

要求3：TXT文本文件路径和工作博路径相同，导入时
	直接导入内容即可，不要再选择打开文件浏览对话框，找到上述txt文件

最佳答案

月排行榜 / 总排行榜

wanao2008

2016-2-17 21:07

请测试！
Sub wanao2008()
    Dim txtLine, FileObj, TextObj, FilePath
    Dim regEX As Object, mc1, mc2, hs As Integer
    Dim MyStr As String, Lie As Integer
    Set regEX = CreateObject("VBSCRIPT.REGEXP")
    Set FileObj = CreateObject("Scripting.FileSystemObject")
    regEX.Global = True
    regEX.Pattern = "\t"
    '设置模块2的起始列和行
    Lie = 10
    hs = 3
    FilePath = ThisWorkbook.Path & "\需要导入的内容.txt"
    Set TextObj = FileObj.OpenTextFile(FilePath, 1, True)
    Do While Not TextObj.AtEndOfLine
        '读取行内容
        txtLine = TextObj.readline
        Set mc2 = regEX.Execute(txtLine)
        If Cells(hs, mc2.Count + Lie) = "" Then
            Cells(hs, mc2.Count + Lie) = Trim(txtLine)
        Else
            Cells(Cells(20, mc2.Count + Lie).End(xlUp).Row + 1, mc2.Count + Lie) = Trim(txtLine)
        End If
     Loop
    TextObj.Close
    Set TextObj = Nothing
    Set FileObj = Nothing
End Sub

跳转到最佳答案楼层

wanao2008

请测试！
Sub wanao2008()
    Dim txtLine, FileObj, TextObj, FilePath
    Dim regEX As Object, mc1, mc2, hs As Integer
    Dim MyStr As String, Lie As Integer
    Set regEX = CreateObject("VBSCRIPT.REGEXP")
    Set FileObj = CreateObject("Scripting.FileSystemObject")
    regEX.Global = True
    regEX.Pattern = "\t"
    '设置模块2的起始列和行
    Lie = 10
    hs = 3
    FilePath = ThisWorkbook.Path & "\需要导入的内容.txt"
    Set TextObj = FileObj.OpenTextFile(FilePath, 1, True)
    Do While Not TextObj.AtEndOfLine
        '读取行内容
        txtLine = TextObj.readline
        Set mc2 = regEX.Execute(txtLine)
        If Cells(hs, mc2.Count + Lie) = "" Then
            Cells(hs, mc2.Count + Lie) = Trim(txtLine)
        Else
            Cells(Cells(20, mc2.Count + Lie).End(xlUp).Row + 1, mc2.Count + Lie) = Trim(txtLine)
        End If
     Loop
    TextObj.Close
    Set TextObj = Nothing
    Set FileObj = Nothing
End Sub

wanao2008

你可以自己改，我告诉你个方法：
由于没想到你的数据会操作20行，所以我设置了个常量20：
Cells(Cells(20, mc2.Count + Lie).End(xlUp).Row + 1, mc2.Count + Lie) = Trim(txtLine)
这个20个你看着改吧

neicezhanghao

跪求各位大神 大哥 大姐 大叔 大神 大爷 大妈 好心雷锋 帮帮忙 小弟感激不尽 跪谢！！！

neicezhanghao

wanao2008 发表于 2016-2-17 21:07
请测试！
Sub wanao2008()
    Dim txtLine, FileObj, TextObj, FilePath

首先 谢谢您的帮助

我测试了 非常强大 但是由于我疏忽了一个要求 再帮帮我把 麻烦您了！
需要导入的内容 不固定的 我增加内容后 不对了！帮我看看啊 大哥！

neicezhanghao

wanao2008 发表于 2016-2-17 21:49
你可以自己改，我告诉你个方法：
由于没想到你的数据会操作20行，所以我设置了个常量20：
Cells(Cells(2 ...

好的 谢谢您  非常感谢 麻烦您了！

wanao2008

neicezhanghao 发表于 2016-2-17 21:56
好的 谢谢您  非常感谢 麻烦您了！

还是不太对，这个程序里用了正则表达式，因为我也是刚学，制作中会有问题。
再一个，你提供的新文本文件和一开始的不一样，新的文本文件数字后面带制表符。
我是通过制表符的个数来计列的，这样，它们都有4个制表符，所以就都到一列去了。
等明天我再看看，今天睡觉了！
要不你请高手改一下正则吧？
再见！