Question

我正在尝试为我的Finance VBA课程组创建一个复制工具，允许用户导入一系列工作簿，从每个工作簿复制相同的几列，并将这些列聚合到一个工作簿中。

为方便起见，我附上了一组示例导入文件以及这些文件的所需输出。

另外值得注意的是，在Q1和Q2中，只是复制了B列。但是，在Q3中，它是B列，C被复制。

这是我目前的代码。目前，它仅从1个工作簿进行复制，并且只是在整个工作簿的其余部分重复相同的列（尽管我能够导入多个工作簿）。任何帮助都将不胜感激！谢谢！

Sub import()
Dim OutputWorkbook As Workbook, InputWorkbook As Workbook, lInputWorkbookName As String, fDialog As Office.FileDialog, _
varFile As Variant, i As Long, sheet As Worksheet, cell As Range, _
Interest_Income As Range, temp As String, sourceColumn As Range,  targetColumn As Range _

ThisWorkbook.Activate

On Error GoTo handler

Set OutputWorkbook = ThisWorkbook
Set targetColumn = OutputWorkbook.Sheets("Taxable Income Aggregate").Columns("C:XED")


ThisWorkbook.Activate

  ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogOpen)

   With fDialog
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      Application.AskToUpdateLinks = False
      Application.CutCopyMode = False
  ' Allow user to make multiple selections in dialog box
      .AllowMultiSelect = True

  .Title = "Import Your Workbooks"

  .Filters.Clear
  .Filters.Add "Excel 97-2003 Workbook", "*.xls"
  .Filters.Add "Excel Workbook", "*.xlsx"
  .Filters.Add "Excel Binary Workbook", "*.xlsb"
  .Filters.Add "Macro-Enabled Workbook", "*.xlsm"
  .Filters.Add "All", "*.*"

  ' Show the dialog box.
      If .Show = True Then
        Application.ScreenUpdating = False

        For Each varFile In .SelectedItems
            Workbooks.Open (varFile)
            lInputWorkbookName = Mid(varFile, InStrRev(varFile, "\") + 1)
            Set sheet = varFile.Sheets("Taxable Income Summary").Columns("B")
            For Each sheet In Workbooks(lInputWorkbookName).Sheets("Taxable Income Summary").Columns("B")
                sourceColumn.Copy Destination:=targetColumn

                'For populating Taxable Income Aggregate
                'If sheet.Name Like "Taxable Income Summary" Then
                'End If
            Next

            Workbooks(lInputWorkbookName).Close
         Next

         OutputWorkbook.Sheets("Taxable Income Aggregate").Activate


         Application.ScreenUpdating = True
         Application.DisplayAlerts = True
         Application.AskToUpdateLinks = True
         Application.CutCopyMode = True
      Else
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   End With

Exit Sub
handler:
    MsgBox Err.Description
End Sub

复制工具 - ＆gt; https://drive.google.com/file/d/0B-QauGO0OicTMEFEUlFvY28wNFU/view?usp=sharing

输入3 - ＆gt; https://drive.google.com/open?id=0B-QauGO0OicTUHJuMUs5UlVuU2s

Answer 1

除了“Q3是B列和C列”，我没有得到（如何知道该怎么做），这应该有效：

Sub import()
  On Error GoTo handler
  ThisWorkbook.Activate

  Dim OutputWorksheet As Object
  Set OutputWorksheet = ThisWorkbook.Sheets("Taxable Income Aggregate")

  Dim actCol As Long
  actCol = 3

  With Application.FileDialog(msoFileDialogOpen)

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.AskToUpdateLinks = False
    Application.CutCopyMode = False

    .AllowMultiSelect = True
    .Title = "Import Your Workbooks"

    .Filters.Clear
    .Filters.Add "All Excel Files", "*.xl*"
    .Filters.Add "All Files", "*.*"

    If .Show = True Then
      Application.ScreenUpdating = False

      Dim varFile As Variant    
      For Each varFile In .SelectedItems
        With Workbooks.Open(varFile)

          Dim xSheet As Object
          For Each xSheet In .Sheets
            If xSheet.Name Like "*Taxable Income Summary*" Then

              'Don't know how to ckeck for Q3
              'You still need to add that code

              xSheet.Columns("B").Copy OutputWorksheet.Column(actCol)
              actCol = actCol + 1
            End If
          Next
          .Close 0

        End With
      Next

      OutputWorksheet.Activate

    Else
      MsgBox "You clicked Cancel in the file dialog box."
    End If
  End With

  Application.AskToUpdateLinks = True

  Exit Sub

handler:
  MsgBox Err.Description
  Application.AskToUpdateLinks = True
End Sub

DisplayAlerts和ScreenUpdating会自动设置为True（因此无需手动设置），CutCopyMode永远不需要转为“真”（实际上：它根本无法转为True

我也“跳过”了你的一些变数。

要复制的目标是通过actCol

设置的

其余的应该是自我解释。

如果您仍有疑问或麻烦，请发表评论。

Excel VBA宏：导入工作簿，复制列和通过导入的工作簿循环

1 个答案: