Question

我想将csv文件导入到我自己的工作簿中。现在，它每次都创建一个新的工作簿。我想将csv文件中的数据放入不同的工作表中。只有我希望将数据设置为11个标准表，因为我有11个团队（团队A，团队B等）。当前它确实起作用，因为它创建了一个包含11张纸的新工作簿。

我设置了要用于项目的Excel文件。在这种情况下，有几个团队每天将数据导出到csv文件。现在，我想将这些文件导入到我的活动工作簿中，每个团队在其中都有自己的工作表。 CSV数据文件将需要使用按钮导入。然后，csv数据将进入同一工作簿。

我在网上找到了以下代码，效果很好！这种方法的唯一问题是它每次都会创建一个新的工作簿。然后，我必须将数据从新生成的工作簿（工作表中每个团队的数据）复制到我自己的工作簿中。

此复制粘贴就像您可以想象的那样很烦人。我希望有任何一个擅长编程的人，可以对我有所帮助：）？我目前用于将数据导入到随机生成的工作簿中的代码如下：

Sub DataImporteren()


    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

所以最后我需要帮助：我有概述的标准工作簿。用计算和公式比较导入的数据。（已经可以使用了）

每次将数据导入到此标准工作簿中，而不是将该宏导入到新的工作簿中。

对于（标准csv文件中）我的工作簿中的每个团队，使用标准表。 CSV文件：每次导入新的更新的Team A csv文件等时，“ Team A”都会导入到工作表Team A中。

我希望有人能帮助我，因为这将节省我很多复制粘贴的时间。

Answer 1

以下对我有用。问题中的代码有很多更改。

在打开文件之前，将目标工作簿设置在开头附近，这将更改“活动”工作簿。这样，就不会造成混乱。
整个复制处于For...Next循环中。据我所知，没有理由执行一次，然后执行一个循环。我使用For...Next是为了使x自动递增。
该问题中出现的实际问题是由于未指定 target 而应在其中插入csv文件的内容。如果未指定目标范围，则数据将放置在新的工作簿中。因此，目标范围设置为目标工作簿中的工作表（x +1）；将复制传入数据表的UsedRange（而不是整个工作表）-这会将数据放置在目标工作表的左上方。
x + 1是因为数据应转到第二个及以下工作表。
仅在复制和插入并且变量设置为Nothing之后，数据表才关闭。在我的测试中，这种方法更加可靠。

按现状，Excel将在引入新数据时查询是否覆盖现有工作表内容。如果不希望这样做，请在插入数据之前插入一行以删除每个工作表的UsedRange。

Sub DataImporteren()
    Dim FilesToOpen
    Dim x As Long
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim wsData As Worksheet
    Dim rngDestination As Range
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"
    x = 1

    Set wkbAll = ActiveWorkbook
    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

    For x = 1 To UBound(FilesToOpen)
        'Start at second worksheet
        Set rngDestination = wkbAll.Worksheets(x + 1).Range("A1")
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        Set wsData = wkbTemp.Worksheets(1)
        wsData.UsedRange.Copy rngDestination

        wkbAll.Worksheets(x + 1).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

        wkbTemp.Close False
        Set wkbTemp = Nothing
    Next

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

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub

将每日CSV文件导入到标准Excel工作表位置

1 个答案: