[已解决]导入txt文件程序出错

Saint_Zuo

想将“原始数据.txt”中的数据全部导入到“大量数据多工作表导入.xls”中，要求导入的数据超过新建的"data1"工作表的65536行则自动新建一个工作表"data2"，继续在"data2"中导入，当"data2"中达到65536行后则自动新建一个工作表"data3"，依此类推，直到数据全部导入工作簿中。thiswookbook编辑器中已经有一段程序，但不知什么原因无法正常运行。不是提示对象属性错误，就是提示文件已打开。麻烦各位帮忙看看程序那里不对？ lZ8KzZUT.rar (122.52 KB, 下载次数: 0)

2009-12-22 11:33 上传

点击文件名下载附件
导入txt文件程序出错

最佳答案

月排行榜 / 总排行榜

amulee

2009-12-22 12:06

VBA里面的MOD用法错误

 

Sub OpenText()
    Application.ScreenUpdating = False
    Dim Filename As String
    Dim myText As String
    Dim mArr() As String
    Dim j As Long
    Dim i As Integer
    i = 1
    Filename = ThisWorkbook.Path & "\原始数据.txt"
    j = 1
    Open Filename For Input As #1
    Do While Not EOF(1)
        If j Mod 65536 = 1 Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = "data" & i
            i = i + 1
            j = 1
        End If
        Line Input #1, myText
        mArr = Split(myText, ",")
        ActiveSheet.Cells(j, 1).Resize(1, UBound(mArr)) = mArr
        j = j + 1
    Loop
    Close #1
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

amulee

VBA里面的MOD用法错误

 

Sub OpenText()
    Application.ScreenUpdating = False
    Dim Filename As String
    Dim myText As String
    Dim mArr() As String
    Dim j As Long
    Dim i As Integer
    i = 1
    Filename = ThisWorkbook.Path & "\原始数据.txt"
    j = 1
    Open Filename For Input As #1
    Do While Not EOF(1)
        If j Mod 65536 = 1 Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = "data" & i
            i = i + 1
            j = 1
        End If
        Line Input #1, myText
        mArr = Split(myText, ",")
        ActiveSheet.Cells(j, 1).Resize(1, UBound(mArr)) = mArr
        j = j + 1
    Loop
    Close #1
    Application.ScreenUpdating = True
End Sub

Saint_Zuo

QUOTE:

以下是引用amulee在2009-12-22 12:06:00的发言：

VBA里面的MOD用法错误

 

Sub OpenText()
    Application.ScreenUpdating = False
    Dim Filename As
  String
    Dim myText As
  String
    Dim mArr() As
  String
    Dim j As
  Long
    Dim i As
  Integer
    i = 1
    Filename = ThisWorkbook.Path & "\原始数据.txt"
    j = 1
    Open Filename For
  Input
  As #1
    Do
  While
  Not EOF(1)
        If j Mod 65536 = 1 Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = "data" & i
            i = i + 1
            j = 1
        End
  If
        Line Input #1, myText
        mArr = Split(myText, ",")
        ActiveSheet.Cells(j, 1).Resize(1, UBound(mArr)) = mArr
        j = j + 1
    Loop
    Close #1
    Application.ScreenUpdating = True
End
  Sub

多谢你的程序。我想请教一下一个问题。我将程序运行一次之后把Data1、data2、data3三张表全部删除，然后再运行一次会提示“文件已打开”是怎么回事，程序无法执行了，Close #1语句不是已经将txt文件关闭了吗？

[此贴子已经被作者于2009-12-22 13:50:43编辑过]

amulee

QUOTE:

以下是引用Saint_Zuo在2009-12-22 13:50:00的发言：

多谢你的程序。我想请教一下一个问题。我将程序运行一次之后把Data1、data2、data3三张表全部删除，然后再运行一次会提示“文件已打开”是怎么回事，程序无法执行了，Close #1语句不是已经将txt文件关闭了吗？

因为你前面的程序有错，还没有执行到Close就跳出了。

用我的没问题。

Saint_Zuo

QUOTE:

以下是引用amulee在2009-12-22 13:59:00的发言：

因为你前面的程序有错，还没有执行到Close就跳出了。

用我的没问题。

amulee老师，我先将原程序和您的程序同放在了一个thiswookbook编辑器中，第一次运行您的程序没问题，之后我将data1-3三张表删除，再运行您的程序先出现"应用程序定义或对象定义错误"，再运行就出现文件已打开的错误？我后来将您的程序复制到一个新的文件中单独的多次运行就没这个问题了。但这个问题我还是没搞懂，既然提示文件已打开为什么在任务栏中却看不到txt文件打开呢？

[此贴子已经被作者于2009-12-22 15:32:16编辑过]

amulee

QUOTE:

以下是引用Saint_Zuo在2009-12-22 15:21:00的发言：

amulee老师，我先将原程序和您的程序同放在了一个thiswookbook编辑器中，第一次运行您的程序没问题，之后我将data1-3三张表删除，再运行您的程序先出现"应用程序定义或对象定义错误"，再运行就出现文件已打开的错误？我后来将您的程序复制到一个新的文件中单独的多次运行就没这个问题了。但这个问题我还是没搞懂，既然提示文件已打开为什么在任务栏中却看不到txt文件打开呢？

1、是否两个程序名称相同？

2、这个打开不是你熟知的那种打开。你可以把这种打开理解为在后台打开。

Saint_Zuo

QUOTE:

以下是引用amulee在2009-12-22 15:58:00的发言：

1、是否两个程序名称相同？

2、这个打开不是你熟知的那种打开。你可以把这种打开理解为在后台打开。

amulee老师，您在学习上给了我很大的帮助，再次感谢您的指导。我把两个程序的名称是设置为不同的。

amulee

QUOTE:

以下是引用Saint_Zuo在2009-12-22 16:30:00的发言：

amulee老师，您在学习上给了我很大的帮助，再次感谢您的指导。我把两个程序的名称是设置为不同的。

不客气。照理说是不应该出错的。要不你传上来看看。

zsd5237

学习[em02][em02]

Saint_Zuo

我今天又试了一下没问题了，昨天可能是我不小心运行了OpenText1()，再运行OpenText2()就不行了，所以我根据您的提示先运行了一个  Close #1语句再运行OpenText2()就可以了。还有一个问题是Open Filename For Input As #1中的1究竟是指的是什么？是源数据文件格式代号（例如txt文件的代号为1）还是指导入的文件顺序号呢（1表示导入的第一个文件，2表示导入的第二个文件等等）？再次感谢了。 hh3njD6u.rar (9.12 KB, 下载次数: 0)

2009-12-23 09:04 上传

点击文件名下载附件

[此贴子已经被作者于2009-12-23 9:04:24编辑过]