[已解决]谢谢爱疯老师，外部数据导入出错

lhj323323

kJpClIF5.rar (20.33 KB, 下载次数: 42)

2010-11-9 17:52 上传

点击文件名下载附件
[求助]外部数据导入出错

老师，需求如题，请帮忙看看，我错在哪里了，谢谢。该怎么改？

[此贴子已经被作者于2010-11-10 1:40:36编辑过]

最佳答案

月排行榜 / 总排行榜

爱疯

2010-11-10 00:22

Sub a()
    Dim p As String, f As String, s As String

    Application.ScreenUpdating = False
    p = ThisWorkbook.Path
    f = Dir(p & "\*.txt")
    Do While f <> ""
        s = Left(f, Len(f) - 4)
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(s).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = s
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & p & "\" & f, Destination:=[A1])
            .Refresh BackgroundQuery:=False
        End With
        f = Dir
    Loop
    Sheets(1).Select
    Application.ScreenUpdating = True
End Sub

[em09]

[em09]

跳转到最佳答案楼层

lhj323323

sArr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbLf)

是否是上面这一句有问题，需要改？

爱疯

NDESTY9Q.rar (13.88 KB, 下载次数: 5)

2010-11-9 21:36 上传

点击文件名下载附件
[求助]外部数据导入出错
这样改了，行吗？

如果有其它条件，可能还要修改。

[em09]

lhj323323

QUOTE:

以下是引用爱疯在2010-11-9 21:38:00的发言：

这样改了，行吗？

如果有其它条件，可能还要修改。

[em09]

Sub a()
    Dim sh As Worksheet
    Dim p As String, f As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "首页" Then sh.Delete
    Next
    Application.DisplayAlerts = True

    p = ThisWorkbook.Path
    f = Dir(ThisWorkbook.Path & "\*.txt")
    Do While f <> ""
        Sheets.Add after:=Sheets(Sheets.Count)
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & p & "\" & f, Destination:=[A1])
            ActiveSheet.Name = Left(f, Len(f) - 4)
            .Refresh BackgroundQuery:=False
        End With
        f = Dir
    Loop
    Sheets(1).Select
    Application.ScreenUpdating = True
End Sub

爱疯老师：

由于模板内除了首页这个工作表和外部导入的两张工作表，我还需要在模板内保留其它的多个工作表，能否将程序改为，不要增加或是删除既定的工作表？

或是在导入外部数据前，只将模板中的存放这两个外部数据的工作表删除，但模板内其它的工作表给保留？

[此贴子已经被作者于2010-11-10 0:07:13编辑过]

爱疯

Sub a()
    Dim p As String, f As String, s As String

    Application.ScreenUpdating = False
    p = ThisWorkbook.Path
    f = Dir(p & "\*.txt")
    Do While f <> ""
        s = Left(f, Len(f) - 4)
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(s).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = s
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & p & "\" & f, Destination:=[A1])
            .Refresh BackgroundQuery:=False
        End With
        f = Dir
    Loop
    Sheets(1).Select
    Application.ScreenUpdating = True
End Sub

[em09]

[em09]

fjmxwrs

跟来学习