Question

我正在制作一个自动模板，将多个csv文件导入到我创建的Excel模板中的多个工作表中。

到目前为止，我在模板中有一张工作表，其中有一个名为Results的表和一个名为Login ID的列。我编写了以下脚本来自动创建工作表并命名它们。我的表数据从第7行开始。

Sub Prepare_Report()
Dim WS As Worksheet

'   Go to the results page
    Sheets("Results Page").Select

'   Create all additional sheets from Login ID field in the results table
    Dim N As Long, I As Long
    N = Range("Results[Login ID]").Rows.Count + 6
    For I = 7 To N
    aName = Worksheets("Results Page").Range("C" & I).Value
    Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))
    WS.Name = aName
    Next I

我必须导入的每个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导入问题，任何想法都将非常感激。

Answer 1

这会做你想要的！

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

VBA将多个CSV文件导入excel中的多个工作表

1 个答案: