在VBA中查找字串并根據不同標準引入新資料

目前，我有一個腳本可以根據“上次運行日期”從各種作業簿中獲取資料并將它們放在我的主報告中的特定位置。

這些作業簿的范圍略有變化。現在，不是僅在作業簿中找到的 ONE DATE (10-25-2021) 粘貼在最后一個之下，現在需要粘貼在現有日期之上 30 天。

例如，10-25-2021作業簿中有9-25-2021 到 10-25-2021 的資料（30 天）。我的主要作業簿中包含截至 2021 年 10 月 24 日的資料。它應該從10-25-2021 作業簿的第二行（所有選擇向右下方）復制資料，并將其粘貼到主作業簿中，找到 9-25-2021 及以下的第一行。這應該足以填充所有現有資料并繼續缺少的日期，因為資料每天都遵循相同的行號/列。

知道怎么做嗎？

非常感謝。

Sub Code()

Dim wb1 As Workbook
Dim raspuns As String

Const FOLDER_PATH = "\\emag.local\ro\Financial\Controlling&Reporting\Reporting\6_Marketing\FY_2021\Budget\RO\Drivers\Input Daily Reports"

Dim FSO As Object, fld
Dim dtLastRun As Date

Application.ScreenUpdating = False
   
    
ThisWorkbook.Worksheets("PPV").Activate
dtLastRun = ActiveSheet.Range("A700000").End(xlUp)

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each fld In FSO.getfolder(FOLDER_PATH).SubFolders
        If (fld.Name > Format(dtLastRun, "yyyy_mm_dd")) And _
           (fld.Name <= Format(Now, "yyyy_mm_dd")) Then
                    



    Set wb1 = Workbooks.Open("\" & fld & "\PPV.csv")
        wb1.Worksheets("PPV").Activate

        wb1.Worksheets("PPV").Range("a2", Range("a2").End(xlDown).End(xlToRight)).Select
        Selection.Copy
        
        
    ThisWorkbook.Worksheets("PPV").Activate
    
    lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Cells(lastrow   1, 1).Select
    ActiveSheet.Paste
    
    Application.CutCopyMode = False
    
    wb1.Close SaveChanges:=False
    
    
   

Set wb1 = Nothing
Set lastrow = Nothing

uj5u.com熱心網友回復：

從復制范圍的單元格 (1) 中獲取新資料的開始日期。使用“查找”在報告表的 A 列中搜索該日期，如果找到，則將復制的資料粘貼到其中。

Option Explicit

Sub Code()
    Const FOLDER_PATH = '\\emag.local\ro\Financial\Controlling&Reporting\Reporting\6_Marketing\FY_2021\Budget\RO\Drivers\Input Daily Reports"
    
    Dim wb As Workbook, wsPPV As Worksheet
    Dim FSO As Object, fld, lastrow As Long
    Dim rngSrc As Range, rngTarget As Range
    Dim dtLastRun As Date, dtStart As Date

    Set wb = ThisWorkbook
    Set wsPPV = wb.Sheets("PPV")
    dtLastRun = wsPPV.Cells(Rows.Count, "A").End(xlUp).Value2
    MsgBox "Last run was " & Format(dtLastRun, "dd-mmm-yyyy")

    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each fld In FSO.getfolder(FOLDER_PATH).SubFolders

        If (fld.Name > Format(dtLastRun, "yyyy_mm_dd")) And _
            (fld.Name <= Format(Now, "yyyy_mm_dd")) Then
                 
            ' open workbook and get start date
            Set wb = Workbooks.Open("\" & fld & "\PPV.csv")
            Set rngSrc = wb.Sheets("PPV").Range("A2", Range("A2").End(xlDown).End(xlToRight))
            dtStart = rngSrc.Cells(1)
        
            ' find start date on wsPPV and paste
            Set rngTarget = wsPPV.Range("A:A").Find(dtStart, LookIn:=xlFormulas, lookAt:=xlWhole)
            If rngTarget Is Nothing Then
                MsgBox "Start Date " & Format(dtStart, "dd-mmm-yyyy") & " not found", vbCritical, dtStart
            Else
                rngSrc.Copy rngTarget
                Application.CutCopyMode = False
                MsgBox fld & " " & rngSrc.Address & " copied to " & rngTarget.Address
            End If
           
            wb.Close SaveChanges:=False
        
        End If
    Next
End Sub

標籤：擅长 vba

上一篇：通過隱藏行的動態數字串列

下一篇：溢位范圍的條件格式