如何为VBA的ProcessNamedRanges函数添加Ted ID匹配过滤条件？

Let's get this sorted out. The core idea is to add a check that only processes rows from your "Output - Flat" sheet where the Ted ID matches the current template's assigned Ted ID. Here's how to implement this, with two common scenarios depending on how you store template-specific Ted IDs:

Step 1: Define Your Ted ID Sources #

First, confirm two key details:

• In your Output - Flat worksheet, there's a column containing the Ted ID for each row of data (we'll assume this is column C for the examples—adjust if your setup is different).
• Each template has a way to identify its target Ted ID (we'll cover two practical methods below).

Option 1: Ted ID Stored Directly in the Template #

If each template saves its Ted ID in a consistent cell (like cell A1 on the RVP Local GAAP worksheet), use this modified ProcessNamedRanges function:

Sub ProcessNamedRanges(ByRef wb As Workbook)
    Dim dstRng As Range
    Dim rng As Range
    Dim rngName As Variant
    Dim rngNames As Range
    Dim wks As Worksheet
    Dim templateTedID As Variant
    Dim dataTedID As Variant
    
    Set wks = ThisWorkbook.Sheets("Output - Flat")

    ' Exit if no named ranges are listed
    If wks.Range("D4") = "" Then Exit Sub

    ' Retrieve the current template's Ted ID (adjust cell reference as needed)
    On Error Resume Next
    templateTedID = wb.Worksheets("RVP Local GAAP").Range("A1").Value
    On Error GoTo 0
    ' Exit if we couldn't fetch the template's Ted ID
    If IsEmpty(templateTedID) Then Exit Sub

    Set rngNames = wks.Range("D4").CurrentRegion
    ' Expand range to include the Ted ID column (column C) and NamedRange column (column D)
    Set rngNames = Intersect(rngNames.Offset(1, 0), rngNames.Columns("C:D"))

    ' Loop through each row of Ted ID + NamedRange pairs
    For Each rng In rngNames.Rows
        dataTedID = rng.Cells(1, 1).Value ' Get Ted ID from column C
        rngName = rng.Cells(1, 2).Value ' Get NamedRange from column D

        ' Only process rows where Ted IDs match
        If dataTedID = templateTedID Then
            ' Verify the named range exists in the template
            On Error Resume Next
            Set dstRng = wb.Names(rngName).RefersToRange
            If Err = 0 Then
                ' Write the report balance to the template (adjust offset if your balance is in a different column)
                dstRng.Value = rng.Offset(0, 1).Value ' Balance is in column E here (D+1)
            End If
            On Error GoTo 0
        End If
    Next rng
End Sub

Key Modifications: #

• We pull the template's Ted ID from a fixed cell (update Range("A1") to match where your template stores its ID).
• We expand rngNames to include both the Ted ID and NamedRange columns, so we can check each row's ID before processing.
• We added a critical check: If dataTedID = templateTedID Then to skip non-matching rows entirely.

Option 2: Ted ID Mapped to Template Filenames #

If you prefer to map template filenames directly to Ted IDs (e.g., "Template1.xlsm" = 10004, "Template2.xlsm" = 11372), use a dictionary to manage the mapping:

Sub ProcessNamedRanges(ByRef wb As Workbook)
    Dim dstRng As Range
    Dim rng As Range
    Dim rngName As Variant
    Dim rngNames As Range
    Dim wks As Worksheet
    Dim templateTedID As Variant
    Dim dataTedID As Variant
    Dim tedIDMap As Object ' Dictionary for filename -> Ted ID mapping

    Set wks = ThisWorkbook.Sheets("Output - Flat")
    Set tedIDMap = CreateObject("Scripting.Dictionary")

    ' Exit if no named ranges are listed
    If wks.Range("D4") = "" Then Exit Sub

    ' Define your template filename to Ted ID mapping here
    tedIDMap.Add "Template1.xlsm", 10004
    tedIDMap.Add "Template2.xlsm", 11372
    tedIDMap.Add "Template3.xlsm", 12345 ' Add more entries as needed

    ' Get the current template's Ted ID from the dictionary
    If tedIDMap.Exists(wb.Name) Then
        templateTedID = tedIDMap(wb.Name)
    Else
        Exit Sub ' Skip templates not in the mapping
    End If

    Set rngNames = wks.Range("D4").CurrentRegion
    ' Expand range to include Ted ID (column C) and NamedRange (column D)
    Set rngNames = Intersect(rngNames.Offset(1, 0), rngNames.Columns("C:D"))

    ' Loop through each row of Ted ID + NamedRange pairs
    For Each rng In rngNames.Rows
        dataTedID = rng.Cells(1, 1).Value ' Get Ted ID from column C
        rngName = rng.Cells(1, 2).Value ' Get NamedRange from column D

        ' Only process rows where Ted IDs match
        If dataTedID = templateTedID Then
            ' Verify the named range exists in the template
            On Error Resume Next
            Set dstRng = wb.Names(rngName).RefersToRange
            If Err = 0 Then
                ' Write the report balance to the template
                dstRng.Value = rng.Offset(0, 1).Value ' Balance is in column E here
            End If
            On Error GoTo 0
        End If
    Next rng
End Sub

Key Modifications: #

• We use a Scripting.Dictionary to explicitly map each template's filename to its Ted ID—update this list to match your actual files and IDs.
• We check if the current template's name exists in the dictionary before proceeding, skipping any unlisted templates.

Important Adjustments for Your Setup #

• Column References: Change Columns("C:D"), rng.Cells(1,1), or rng.Offset(0,1) to match your actual Output - Flat sheet structure (e.g., if Ted ID is in column A, swap C for A).
• Data Types: If your Ted IDs are stored as text instead of numbers, ensure the values in the template/dictionary match exactly (no leading/trailing spaces).
• Error Handling: Add extra checks if needed (e.g., alert if a template's Ted ID is missing, or log skipped rows).

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