從特定日期後創建的不同工作簿中收集信息

我正在使用以下代碼從各種工作簿中將特定單元格內容收集到跟蹤工作表中。從特定日期後創建的不同工作簿中收集信息

Sub CopyRangeValues() 
    Dim basebook As Workbook 
    Dim mybook As Workbook 
    Dim FNames As String 
    Dim rnum As Long 
    Dim y As Variant 
    Application.ScreenUpdating = False 
    ChDrive "D:\" 
    ChDir "D:\" 
    FNames = Dir("Sample-*.xl*") 
    If FNames <> "" Then 
     Set basebook = ThisWorkbook 
     y = InputBox("What column should start getting the values", "Input Row Value", 2) 
     If y = "" Then Exit Sub 'cancel hit 
     rnum = Val(y) 
     Do While FNames <> "" 
      Set mybook = Workbooks.Open(FNames) 
      basebook.Worksheets(1).Cells(rnum, 1).Value = mybook.Worksheets(1).Range("D1").Value 
      basebook.Worksheets(1).Cells(rnum, 2).Value = mybook.Worksheets(1).Range("G1").Value 
      basebook.Worksheets(1).Cells(rnum, 3).Value = mybook.Worksheets(1).Range("C5").Value 
      basebook.Worksheets(1).Cells(rnum, 4).Value = mybook.Worksheets(1).Range("C8").Value 
      basebook.Worksheets(1).Cells(rnum, 5).Value = mybook.Worksheets(1).Range("C9").Value 
      mybook.Close False 
      rnum = rnum + 1 
      FNames = Dir() 
     Loop 
    End If 
    Application.ScreenUpdating = True 
End Sub

我試圖改變代碼，以便我我做初步收集後，啓動的時候它會只因爲它是對最近一次運行已添加的工作簿收集信息。由於所有工作簿的創建日期都在同一個單元格中，因此我試圖使其成爲搜索條件。任何幫助將不勝感激，謝謝！

來源

2014-05-08 user3617332

爲文件名和最後更新日期添加一列：然後您可以使用它來確定是否添加/更新來自給定文件的信息。 –

哇，我沒有意識到人們實際上使用Dir（）等我會選擇Windows腳本運行時列出文件夾中的文件，然後循環檢查每個文件的創建日期。這意味着我不必打開每個工作簿來檢查單元格。 –

假設創建日期在列6中，否則相應地進行修改。

首先，聲明並指定一個用於「開始」日期的日期變量，小於此值將不被使用。

Dim startDate as Date 
    startDate = #1/1/2014# '<-- Modify as needed

並在其中的日期中發現了columnn一個變量：

Dim dateColumn as Integer 
    dateColumn = 6   '<-- Modify as needed

然後，你的循環，以使其只處理與創建日期大於或等於文件中添加一些邏輯到你在startDate變量中定義的那個。

Do While FNames <> "" 
     IF CDate(basebook.Worksheets(1).Cells(rnum, dateColumn).Value) >= startDate 
     Set mybook = Workbooks.Open(FNames) 
     basebook.Worksheets(1).Cells(rnum, 1).Value = _ 
      mybook.Worksheets(1).Range("D1").Value 
     basebook.Worksheets(1).Cells(rnum, 2).Value = _ 
      mybook.Worksheets(1).Range("G1").Value 
     basebook.Worksheets(1).Cells(rnum, 3).Value = _ 
      mybook.Worksheets(1).Range("C5").Value 
     basebook.Worksheets(1).Cells(rnum, 4).Value = _ 
      mybook.Worksheets(1).Range("C8").Value 
     basebook.Worksheets(1).Cells(rnum, 5).Value = _ 
      mybook.Worksheets(1).Range("C9").Value 
     mybook.Close False 
     End If 
     rnum = rnum + 1 
     FNames = Dir() 
    Loop

來源

2014-05-08 17:04:40

從特定日期後創建的不同工作簿中收集信息

回答

相關問題