Vba 从特定日期后创建的不同工作簿中收集信息
我目前正在使用以下代码将各种工作簿中的特定单元格内容收集到跟踪表中Vba 从特定日期后创建的不同工作簿中收集信息,vba,excel,Vba,Excel,我目前正在使用以下代码将各种工作簿中的特定单元格内容收集到跟踪表中 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:\" Ch
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
我正在尝试修改代码,以便在我完成初始收集后,当激活时,它将只收集自上次运行以来添加的工作簿中的信息。因为所有工作簿的创建日期都在同一个单元格中,所以我尝试将其作为搜索条件。任何帮助都将不胜感激,谢谢 假设创建日期在第6列中,否则进行相应修改 首先,声明并分配一个日期变量用于开始日期,小于此值的值将不会被使用
Dim startDate as Date
startDate = #1/1/2014# '<-- Modify as needed
为文件名和上次更新日期添加一列:然后您可以使用该列确定是否添加/更新给定文件中的信息。哇,我没有意识到人们实际上使用Dir等。我会选择Windows脚本运行时在文件夹中列出文件,然后循环检查每个文件的创建日期。这意味着我不必打开每个工作簿来检查单元格。
Dim dateColumn as Integer
dateColumn = 6 '<-- Modify as needed
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