2016-11-04 202 views
1

我正在努力製作一個自動化模板,該工具將多個csv文件導入到我創建的Excel模板中的多個工作表中。VBA將多個CSV文件導入到excel中的多個工作表

到目前爲止,我在模板中有一張名爲「結果」的表格和一個名爲「登錄ID」的列。我寫了下面的腳本來自動創建表單並命名它們。在行我的表中的數據開始7

​​

每個CSV文件,我不得不進口的一個名字命名的登錄ID的作爲,他們也將位於同一文件夾中,我創建的模板。

CSV文件需要稍作修改以從第一列中分離日期和時間。

' Columns("A:A").Select 
' Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
' Columns("B:B").Select 
' Selection.Cut Destination:=Columns("A:A") 
' Columns("A:A").Select 
' Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ 
'  FieldInfo:=Array(Array(0, 1), Array(10, 1)), TrailingMinusNumbers:=True 
' Columns("A:A").Select 
' Selection.NumberFormat = "mm/dd/yy;@" 
' Columns("B:B").Select 
' Columns("B:B").EntireColumn.AutoFit 
' 

任何想法,如果我在正確的軌道上或如何最好地解決我的CSV導入困境將不勝感激。

+0

請問您可否進一步解釋?您想爲每個需要導入的CSV文件創建一個工作表。它實際上是循環遍歷一個包含所有.csv文件的文件夾,並將它們逐個導入到您不確定的每個指定表單中?如果你不確定如何開始,我會建議看看'QueryTables.Add'方法 – kpg987

回答

0

這會做你想做的!

Sub CombineTextFiles() 

    Dim FilesToOpen 
    Dim x As Integer 
    Dim wkbAll As Workbook 
    Dim wkbTemp As Workbook 
    Dim sDelimiter As String 

    On Error GoTo ErrHandler 
    Application.ScreenUpdating = False 

    sDelimiter = "|" 

    FilesToOpen = Application.GetOpenFilename _ 
     (FileFilter:="CSV Files (*.csv), *.csv", _ 
     MultiSelect:=True, Title:="CSV Files to Open") 

    If TypeName(FilesToOpen) = "Boolean" Then 
     MsgBox "No Files were selected" 
     GoTo ExitHandler 
    End If 

    x = 1 
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) 
    wkbTemp.Sheets(1).Copy 
    Set wkbAll = ActiveWorkbook 
    wkbTemp.Close (False) 
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _ 
     Destination:=Range("A1"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, _ 
     ConsecutiveDelimiter:=False, _ 
     Tab:=False, Semicolon:=False, _ 
     Comma:=False, Space:=False, _ 
     Other:=True, OtherChar:="|" 
    x = x + 1 

    While x <= UBound(FilesToOpen) 
     Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) 
     With wkbAll 
      wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count) 
      .Worksheets(x).Columns("A:A").TextToColumns _ 
       Destination:=Range("A1"), DataType:=xlDelimited, _ 
       TextQualifier:=xlDoubleQuote, _ 
       ConsecutiveDelimiter:=False, _ 
       Tab:=False, Semicolon:=False, _ 
       Comma:=False, Space:=False, _ 
       Other:=True, OtherChar:=sDelimiter 
     End With 
     x = x + 1 
    Wend 

ExitHandler: 
    Application.ScreenUpdating = True 
    Set wkbAll = Nothing 
    Set wkbTemp = Nothing 
    Exit Sub 

ErrHandler: 
    MsgBox Err.Description 
    Resume ExitHandler 

End Sub 
相關問題