無法將文件名作爲表名從存儲在導入時

我試圖導入多個文件表1點的數據和數據存儲在不同的sheetnames爲文件名當前工作簿。目前，它可以導入，選擇工作表Sheet1的數據，複製它在當前工作簿但與文件名粘貼。有人可以幫我解決這個問題嗎？無法將文件名作爲表名從存儲在導入時

此外，我想知道，如果這是在內存使用量的情況下，最好的辦法是我的目標是用較大的Excel files.Please導入引導我

我的代碼粘貼在這裏..

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

來源

2017-02-14 Subhasish1315

@ASH你已經給出了答案 ActiveSheet.Name = MID（更換（文件清單（我），「\」，「_」），4）＆「 - 」＆impSheet ，但它無法正常工作。 .. 就像如果我選擇date1.xlsx＆date2.xlsx ....表名稱將是date1.xlsx-Sheet1中，date2.xlsx-工作表Sheet1 .... – Subhasish1315

我已經刪除了答案，很快，因爲我覺得它不完整。它也沒有解決你更重要的問題*「我想知道如果這是最好的方式」......但是無論如何，從你的代碼看來，你想要什麼？ –

Yes..that我想....還有文件清單是一個變體的數據類型，並持有該文件的位置address..am我的權利？如果是的話，有沒有什麼辦法只提取文件名？ – Subhasish1315

-2

貴表名稱編譯板材命名約定。你可以找到他們在下面的鏈接Excel Naming Conventions

嘗試切換您的連字符（ - ）用於下劃線（_）

來源

2017-02-14 11:53:27

問題/評論不應作爲答案發布。要麼提供實現目標的方法，要麼發表評論。 – Zerk

我給了他他需要的資源來糾正錯誤。它不是一個評論它的答案。 –

@SivaprasathV它是如何回答的？它不能解決問題。 – harun24hr

從字符串剔除特殊字符（不能在一個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)

來源

2017-02-14 12:00:15 Zerk

' x = left（x，31）'沒有需要'if'的工作。如果它少於31個字符，那麼它不會受到影響:) –

@VictorMoraes很高興知道，謝謝！ – Zerk

您也可以在不檢查的情況下執行'替換'東西。更好的是，將它們分組循環;即對於數組中的每個ch（「\」，「/」，「*」，「？」，「：」，「[」，「]」）strInput =替換（strInput，ch，「_」）' –

正如我國際泳聯可以理解，你希望工作表的名稱只包含沒有路徑的文件名。

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的東西和工作有明確對象的引用。

來源

2017-02-14 13:07:00

無法將文件名作爲表名從存儲在導入時

回答

相關問題