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

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 文件：每次我导入新的更新的团队 A csv 文件等时，都会将“团队 A”导入工作表团队 A。

我希望有人可以帮助我，因为这样可以节省我大量的复制粘贴时间。

Answer 1

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

• 在打开文件之前，目标工作簿设置在开头附近，这将更改“活动”工作簿。这样就不会造成混淆。
• 整个复制在For...Next 循环中。据我所知，没有理由执行一次，然后循环。我使用了For...Next，以便x 自动递增。
• 问题中提出的实际问题是由于未指定 target 应在其中插入 csv 文件的内容。如果未指定目标范围，则将数据放置在新工作簿中。因此，目标范围设置为目标工作簿中的 Worksheet(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