在日期范围内将数据从一个工作簿导入到另一个工作簿

Question

我打开我的工作簿 (ThisWorkbook)，通过单击按钮可以浏览并选择另一个工作簿 (OpenBook) 并从工作表中导入数据 (Report Data)。

报告数据表中的 I 列包含开始日期，J 列包含每个时期（通常是一个月）的结束日期。

在 ThisWorkbook 中，我有一个名为“说明”的选项卡，我希望允许用户在此选项卡中输入请求。日期（单元格 C8）和结束日期 (E8)，然后代码将引用这些日期并仅导入该范围内的数据。

从我的研究看来，您需要使用自动过滤器，然后复制可见行。但我无法让它工作。

Sub Get_Data_From_File()
  Dim FileToOpen As Variant
  Dim OpenBook As Workbook
  Application.ScreenUpdating = False
  FileToOpen = Application.GetOpenFilename(Title:="Browse for your ADR file & import range", FileFilter:="Excel Files (*.xls*),*xls*")
  If FileToOpen <> False Then
     Set OpenBook = Application.Workbooks.Open(FileToOpen)
     OpenBook.Worksheets("Report Data").Range("A9:MJ128").Copy
     ThisWorkbook.Worksheets("Report Data").Range("A9").PasteSpecial xlPasteValues
     ThisWorkbook.Worksheets("Report Data").Range("A9").PasteSpecial xlFormats
      OpenBook.Close False

End If
Application.ScreenUpdating = False

End Sub

Answer 1

很难用所有不同的文件名复制您的情况，但是我认为这应该可行。代码的关键部分是带有aCell 行的循环，并测试两列是否满足变量begDate 和EndDate 中的预定义条件。如果它们匹配，则只需将值（无需复制粘贴）插入工作表行。有一个计数器 k 将确保宏不会覆盖它自己的成员（仅适用于该过程）。

虽然我没有对此进行测试，但最终它是一个非常简单的项目测试，所以如果您遇到错误，请通过逐步检查您的代码来仔细检查您的变量是否正确。

Sub Get_Data_From_File()
  Dim FileToOpen As Variant
  Dim OpenBook As Workbook, openSheet As Worksheet, iSheet As Worksheet, pSheet As Worksheet
  
  'worksheets
  Set iSheet = ThisWorkbook.Worksheets("Instructions")
  Set pSheet = ThisWorkbook.Worksheets("Report Data")
  'Application.ScreenUpdating = False
  
FileToOpen = Application.GetOpenFilename(Title:="Browse for your ADR file & import range", FileFilter:="Excel Files (*.xls*),*xls*")

    Dim begDate As Date, endDate As Date
  
    begDate = iSheet.Range("C8").Value
    endDate = iSheet.Range("E8").Value
    
  
  
If FileToOpen <> False Then
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    Set openSheet = OpenBook.Worksheets("Report Data")
    
    Dim aCell As Range, k As Long
    For Each aCell In Intersect(openSheet.UsedRange, openSheet.Range("I:I")).Cells
        'loops through rows testing if column i is >= than begdate and column j is <= endDate
        If aCell >= begDate And aCell.Offset(0, 1).Value <= endDate Then
             'when match is found, value is inserted directly to sheet
             pSheet.Range("A9").Offset(k, 0).Value = Intersect(aCell.EntireRow, aCell.Worksheet.Range("A:M")).Value
            'offset will ensure data is no overwritten.
             k = k + 1
        End If
    Next aCell
    OpenBook.Close False

End If
'Application.ScreenUpdating = True

End Sub