Question

我目前正在使用以下代码将各种工作簿中的特定单元格内容收集到跟踪表中。

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

我试图改变代码，以便在我进行初始收集后，在激活时，它只会收集自上次运行以来添加的工作簿中的信息。由于所有工作簿的创建日期都在同一个单元格中，因此我试图将其作为搜索条件。任何帮助将不胜感激，谢谢！

Answer 1

假设创建日期在第6列，否则相应地修改。

首先，声明并指定一个日期变量用于＆＃34; start＆＃34;日期，不会使用小于此值的值。

    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

从特定日期之后创建的不同工作簿中收集信息

1 个答案: