基于关键字的Excel行数据映射至新工作表的VBA可变配置需求

现有VBA宏已实现按表格行中关键字创建含指定工作表的新工作簿，但当前为硬编码逻辑，需改造为无需修改代码即可通过配置自主定义的形式，满足以下需求：

• 自定义工作表分组规则（不同关键字对应不同工作表集合）
• 自定义行数据到输出文件单元格的映射关系
• 输出文件无外部工作表引用，可跨部门邮件流转

已完成基于FSO的模板选择窗体（仅允许选择指定文件夹内的标准模板），但数据映射环节未实现。当前核心硬编码片段如下：

If worksheetSet = "CB" Then
    ThisWorkbook.Sheets("XXXXX").Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
    ThisWorkbook.Sheets("XXXXX)").Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
    ' 重复Copy语句省略
ElseIf worksheetSet = "DH" Then
    ThisWorkbook.Sheets("XXXXX").Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
    ' 重复Copy语句省略
End If

' 硬编码填充单元格
For Each sht In targetWb.Sheets
    sht.Range("C1:C2").Value = ThisWorkbook.Sheets(1).Range("AI14:AI15").Value
    sht.Range("L2").Value = ThisWorkbook.Sheets(1).Range("AI16").Value
    sht.Range("L3").Value = wsCxList.Cells(i, "B").Value
    sht.Range("C3").Value = wsCxList.Cells(i, "D").Value
Next sht

一、配置表设计（主工作表映射表） #

在当前工作簿新增两张配置表，员工直接填写即可完成规则定义：

1. 工作表分组配置表（命名为SheetGroupConfig） #

2. 数据映射配置表（命名为DataMapConfig） #

二、代码改造实现可配置逻辑 #

1. 读取工作表分组配置（替换硬编码If-Else） #

' 获取当前行的关键字（替换为实际关键字所在列）
Dim keyword As String
keyword = wsCxList.Cells(i, "关键字列").Value

' 从配置表读取对应工作表列表
Dim wsGroupConfig As Worksheet
Set wsGroupConfig = ThisWorkbook.Sheets("SheetGroupConfig")
Dim sheetList As String
sheetList = wsGroupConfig.Range("B:B").Find(What:=keyword, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Value

' 拆分列表并复制工作表
Dim sheetNames() As String
sheetNames = Split(sheetList, ",")
Dim sheetName As Variant
For Each sheetName In sheetNames
    ThisWorkbook.Sheets(Trim(sheetName)).Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
Next sheetName

2. 读取数据映射配置并填充（替换硬编码单元格赋值） #

Dim wsMapConfig As Worksheet
Set wsMapConfig = ThisWorkbook.Sheets("DataMapConfig")
Dim lastMapRow As Long
lastMapRow = wsMapConfig.Cells(wsMapConfig.Rows.Count, "A").End(xlUp).Row

' 遍历每条映射规则
Dim mapRow As Long
For mapRow = 2 To lastMapRow
    Dim targetRange As String, sourceRange As String, applyScope As String
    targetRange = wsMapConfig.Cells(mapRow, "A").Value
    sourceRange = wsMapConfig.Cells(mapRow, "B").Value
    applyScope = wsMapConfig.Cells(mapRow, "C").Value
    
    ' 遍历目标工作簿工作表，匹配作用范围后赋值
    For Each sht In targetWb.Sheets
        If applyScope = "所有工作表" Or sht.Name = applyScope Then
            ' 判断数据源类型：数据行列/固定区域
            If Left(sourceRange, 1) Like "[A-Z]" And Not sourceRange Like "*:*" Then
                ' 数据行列：取当前行对应列的值
                sht.Range(targetRange).Value = wsCxList.Cells(i, sourceRange).Value
            Else
                ' 固定区域：直接取指定区域值
                sht.Range(targetRange).Value = ThisWorkbook.Sheets(1).Range(sourceRange).Value
            End If
            ' 转为纯值，清除公式引用
            sht.Range(targetRange).Value = sht.Range(targetRange).Value
        End If
    Next sht
Next mapRow

3. 彻底清除外部引用（确保输出文件独立） #

在保存目标工作簿前，执行以下代码将所有单元格转为纯值：

' 将目标工作簿所有工作表转为纯值，清除所有公式和外部引用
For Each sht In targetWb.Sheets
    sht.UsedRange.Value = sht.UsedRange.Value
Next sht

' 保存并关闭工作簿（替换为实际输出路径）
targetWb.SaveAs "C:\输出路径\文件名.xlsx"
targetWb.Close

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