导入时无法将文件名存储为工作表名称

时间:2017-02-14 11:49:18

标签: excel vba excel-vba

我正在尝试导入多个文件Sheet 1数据并将数据存储在当前工作簿中,并使用不同的工作表作为文件名。  目前它可以导入,选择Sheet1数据,复制它并将其粘贴到当前工作簿中但不能与文件名一起粘贴。有谁可以帮我解决这个问题?

另外我想知道如果这是内存使用情况下的最佳方式,因为我的目标是导入大型excel文件。请指导我

我的代码粘贴在这里..

Sub test()
    Dim i As Integer
    Dim FileList As Variant
    Dim impSheet As String
    Dim ActWorkBk As String
    Dim ImpWorkBk As String
    Dim NoImport As Boolean


    impSheet = "Sheet1"
    FileList = Application.GetOpenFilename( _
    FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook", MultiSelect:=True)

    Application.ScreenUpdating = False
    ActWorkBk = ActiveWorkbook.Name
    NoImport = False

    For i = 1 To UBound(FileList)
        Workbooks.Open (FileList(i))
        ImpWorkBk = ActiveWorkbook.Name
        On Error Resume Next
        ActiveWorkbook.Sheets(impSheet).Select
        If Err > 0 Then
            NoImport = True
            GoTo nxt
        End If
        Err.Clear
        On Error GoTo 0

        ActiveWorkbook.Sheets(impSheet).Copy after:=Workbooks(ActWorkBk).Sheets(Workbooks(ActWorkBk).Sheets.Count)

       'Renames the imported sheet
        On Error Resume Next
        ActiveSheet.Name = FileList(i) & " - " & impSheet
        Err.Clear
        On Error GoTo 0

nxt:
        Workbooks(ImpWorkBk).Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Saved = True
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True
        Workbooks(ActWorkBk).Activate
    Next i

    'Error if some sheets were not found
    If NoImport = True Then MsgBox "One or more sheets could not be found and imported!"
    Application.ScreenUpdating = True
End Sub

3 个答案:

答案 0 :(得分:1)

正如我最终理解的那样,您希望工作表的名称只包含没有路径的文件名。

Dim newSheetName As String, ch
' First get the file's name without path
newSheetName = Mid(FileList(i), 1 + InStrRev(FileList(1), "\"), 1000) & " - " & impsheet

' Trucate the name to the last 31 characters
newSheetName = Right(newSheetName, 31)

' Now remove any forbidden characters from sheet's name
For Each ch In Array("\", "/", "*", "?", ":", "[" , "]")
    newSheetName = Replace(newSheetName, ch, "_")
Next

关于“这是最好的方式”的问题,似乎可以改进整体代码。基本上,您可以将这些更改分组到Application.DisplayAlerts=..内容到循环外部。

最重要的是,你应该摆脱.Activate.ActiveThing的东西并使用显式的对象引用。

答案 1 :(得分:0)

要删除字符串中的特殊字符(不能在Excel工作表名称中使用),请使用此功能:

Public Function Var_Clean(ByVal strInput As String)
    If InStr(1, strInput, "\") > 0 Then strInput = Replace(strInput, "\", "_")
    If InStr(1, strInput, "/") > 0 Then strInput = Replace(strInput, "/", "_")
    If InStr(1, strInput, "?") > 0 Then strInput = Replace(strInput, "?", "_")
    If InStr(1, strInput, "*") > 0 Then strInput = Replace(strInput, "*", "_")
    If InStr(1, strInput, "[") > 0 Then strInput = Replace(strInput, "[", "_")
    If InStr(1, strInput, "]") > 0 Then strInput = Replace(strInput, "]", "_")
    If InStr(1, strInput, ":") > 0 Then strInput = Replace(strInput, ":", "_")
Var_Clean = strInput
End Function

并确保名称的长度不超过31个字符

if len(x) > 31 then x = left(x,31)

答案 2 :(得分:-2)

您的工作表名称是否使用工作表命名约定进行编译。  您可以在Excel Naming Conventions

下面的链接中找到它们

尝试切换连字符( - )作为下划线(_)