Excel宏优化问询：动态数据源文件识别、日期参数自动获取及覆盖式粘贴实现

Hey there! Let's break down each of your requirements and fix up that recorded macro to be more efficient and automated.

1. 自动化识别每周更新的数据源文件 #

Instead of manually typing the filename every week, we can leverage VBA to calculate the required date (last Monday relative to today) and auto-detect the matching file in a specified folder. Here's how to make it work:

Core Logic: #

• Calculate last Monday: Use Date to get today's date, then adjust to the previous Monday using weekday functions.
• Build a filename pattern that matches your naming structure (using the calculated date).
• Use the Dir function to search for the matching file in your target folder.

Code Snippet: #

Sub AutoDetectDataSource()
    Dim targetFolder As String
    Dim lastMonday As Date
    Dim fileNamePattern As String
    Dim sourceFileName As String
    
    ' Update this to your actual data source folder path
    targetFolder = "C:\Your\DataSource\Folder\"
    
    ' Calculate the date of last Monday
    lastMonday = Date - Weekday(Date, vbMonday) + 1
    
    ' Build filename pattern (adjust fixed parts to match your actual naming)
    fileNamePattern = "*FY2022*WE " & Format(lastMonday, "DD-MM-YYYY") & ".xlsx"
    
    ' Search for the matching file
    sourceFileName = Dir(targetFolder & fileNamePattern)
    
    If sourceFileName <> "" Then
        ' Open the found data source file
        Workbooks.Open targetFolder & sourceFileName
        MsgBox "Successfully opened: " & sourceFileName
    Else
        MsgBox "No matching data source file found for last Monday!"
    End If
End Sub

Note: Tweak the fixed parts of fileNamePattern (like *FY2022*) to exactly match the consistent segments of your weekly filenames.

2. 自动获取上月日期并适配指定格式 #

To get the previous month's date (for slicer selection), we can calculate the first day of the previous month and format it to match your slicer's date string format. Here are two common scenarios:

Scenario 1: Slicer uses MM/DD/YYYY format (matches your "1/09/2021" example) #

Sub GetLastMonthDate()
    Dim lastMonthFirstDay As Date
    Dim formattedDate As String
    
    ' Calculate first day of last month
    lastMonthFirstDay = DateSerial(Year(Date), Month(Date) - 1, 1)
    
    ' Format to match slicer's date format
    formattedDate = Format(lastMonthFirstDay, "m/dd/yyyy") ' Outputs "9/01/2021" for September 1st
    
    ' Apply to slicer selection
    ActiveWorkbook.SlicerCaches("Slicer Month").SlicerItems(formattedDate).Selected = True
End Sub

Scenario 2: Slicer uses DD/MM/YYYY format #

Adjust the format string to:

formattedDate = Format(lastMonthFirstDay, "dd/m/yyyy") ' Outputs "01/9/2021"

3. 修改宏以覆盖目标工作表原有数据 #

Instead of creating a new worksheet every time, we can directly target your fixed destination sheet, clear existing data, then paste the new content. Here's the revised macro with this logic:

Updated Macro Code: #

Sub UpdatedMacro1()
    Dim sourceWB As Workbook
    Dim destWS As Worksheet
    Dim lastMonday As Date
    Dim sourceFileName As String
    Dim targetFolder As String
    
    ' Set your fixed destination worksheet (update to your actual sheet name)
    Set destWS = ThisWorkbook.Worksheets("YourTargetSheetName")
    
    ' --- Step 1: Auto-detect and open source file ---
    targetFolder = "C:\Your\DataSource\Folder\"
    lastMonday = Date - Weekday(Date, vbMonday) + 1
    sourceFileName = Dir(targetFolder & "*FY2022*WE " & Format(lastMonday, "DD-MM-YYYY") & ".xlsx")
    
    If sourceFileName = "" Then
        MsgBox "Source file not found!"
        Exit Sub
    End If
    Set sourceWB = Workbooks.Open(targetFolder & sourceFileName)
    
    ' --- Step 2: Clean up slicer selections ---
    With sourceWB.SlicerCaches("Slicer Month")
        ' Deselect all items first (avoids errors if new items are added)
        Dim item As SlicerItem
        For Each item In .SlicerItems
            item.Selected = False
        Next item
        ' Select last month's date
        .SlicerItems(Format(DateSerial(Year(Date), Month(Date)-1, 1), "m/dd/yyyy")).Selected = True
    End With
    
    With sourceWB.SlicerCaches("Slicer_department")
        For Each item In .SlicerItems
            item.Selected = False
        Next item
        .SlicerItems("Category1").Selected = True
    End With
    
    With sourceWB.SlicerCaches("Slicer_manager")
        For Each item In .SlicerItems
            item.Selected = False
        Next item
        .SlicerItems("manager1").Selected = True
    End With
    
    ' --- Step 3: Overwrite data in destination sheet ---
    ' Clear existing data in target range (adjust range as needed)
    destWS.Range("A1:A3").ClearContents
    
    ' Copy and paste first range (use xlPasteValues to avoid formatting issues)
    sourceWB.Worksheets("YourSourceSheetName").Range("F22:M22").Copy
    destWS.Range("A1").PasteSpecial xlPasteValues
    
    ' Repeat for other ranges (adjust source ranges to match your actual data)
    sourceWB.Worksheets("YourSourceSheetName").Range("F23:M23").Copy
    destWS.Range("A2").PasteSpecial xlPasteValues
    
    sourceWB.Worksheets("YourSourceSheetName").Range("F24:M24").Copy
    destWS.Range("A3").PasteSpecial xlPasteValues
    
    ' Cleanup
    Application.CutCopyMode = False
    sourceWB.Close SaveChanges:=False
    MsgBox "Data updated successfully!"
End Sub

*Key improvements:

• No more new sheets: We directly target your fixed destination worksheet.
• Existing data is cleared before pasting to ensure a clean overwrite.
• xlPasteValues avoids bringing over unwanted formatting from the source.
• Added loops to deselect all slicer items first (prevents errors if new items are added to slicers over time).*

内容的提问来源于stack exchange，提问作者theassassin11