Excel中实现Ideas-Domains矩阵自动标记Y的方法求助

一、非VBA动态数组方案（适用于Excel 365/2021+） #

该方案利用动态数组自动适配新增的领域列，无需手动调整公式范围。

1. 提取唯一创意（矩阵行标题） #

假设原始数据在原始数据工作表，Summary（创意）列是A列，在矩阵工作表的B2单元格输入公式：

=UNIQUE('原始数据'!$A:$A)

公式会自动溢出所有唯一的创意，作为矩阵的行。

2. 提取所有领域列（矩阵列标题） #

在矩阵工作表的C1单元格输入公式，提取所有表头包含Custom field (Platform Domain)的列标题：

=UNIQUE(FILTER('原始数据'!$1:$1,ISNUMBER(SEARCH("Custom field (Platform Domain)",'原始数据'!$1:$1))))

公式会自动溢出所有匹配的领域列标题，作为矩阵的列。

3. 自动标记"Y" #

在矩阵工作表的C2单元格输入公式，自动检查对应创意是否属于该领域：

=MAKEARRAY(ROWS(B#),COLS(C#),LAMBDA(r,c,IF(COUNTIFS('原始数据'!$A:$A,INDEX(B#,r),INDEX('原始数据'!$1:$1,MATCH(INDEX(C#,c),'原始数据'!$1:$1,0)),"<>"),"Y","")))

公式会自动生成整个矩阵，对应位置存在关联则标记"Y"。当原始数据新增领域列时，按F9刷新公式即可自动更新矩阵列和标记结果。

二、VBA自动化方案（适用于所有Excel版本） #

如果需要一键更新或数据刷新后自动触发，可使用VBA宏实现完全自动化。

1. 宏代码实现 #

按Alt+F11打开VBA编辑器，插入模块后粘贴以下代码（根据实际工作表名称调整）：

Sub UpdateIdeaDomainMatrix()
    Dim wsSource As Worksheet, wsMatrix As Worksheet
    Dim lastRow As Long, lastCol As Long, i As Long, j As Long
    Dim domainCols As Range, cell As Range
    Dim ideas As Collection, domains As Collection
    
    ' 定义数据源和矩阵工作表
    Set wsSource = ThisWorkbook.Worksheets("原始数据")
    On Error Resume Next
    Set wsMatrix = ThisWorkbook.Worksheets("创意领域矩阵")
    On Error GoTo 0
    If wsMatrix Is Nothing Then
        Set wsMatrix = ThisWorkbook.Worksheets.Add
        wsMatrix.Name = "创意领域矩阵"
    End If
    
    ' 清空旧数据
    wsMatrix.Cells.Clear
    
    ' 筛选所有领域列（表头含指定文本）
    lastCol = wsSource.Cells(1, Columns.Count).End(xlToLeft).Column
    Set domainCols = Nothing
    For j = 1 To lastCol
        If InStr(wsSource.Cells(1, j).Value, "Custom field (Platform Domain)") > 0 Then
            Set domainCols = IIf(domainCols Is Nothing, wsSource.Cells(1, j), Union(domainCols, wsSource.Cells(1, j)))
        End If
    Next j
    
    ' 收集唯一创意和领域
    Set ideas = New Collection
    Set domains = New Collection
    lastRow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
    
    On Error Resume Next
    ' 收集创意（A列为Summary）
    For i = 2 To lastRow
        ideas.Add wsSource.Cells(i, 1).Value, Key:=CStr(wsSource.Cells(i, 1).Value)
    Next i
    ' 收集领域
    For Each cell In domainCols
        domains.Add cell.Value, Key:=CStr(cell.Value)
    Next cell
    On Error GoTo 0
    
    ' 写入矩阵标题
    wsMatrix.Cells(1, 1).Value = "Ideas\Domains"
    For j = 1 To domains.Count
        wsMatrix.Cells(1, j + 1).Value = domains(j)
    Next j
    For i = 1 To ideas.Count
        wsMatrix.Cells(i + 1, 1).Value = ideas(i)
    Next i
    
    ' 标记"Y"
    For i = 2 To wsMatrix.Cells(Rows.Count, 1).End(xlUp).Row
        For j = 2 To wsMatrix.Cells(1, Columns.Count).End(xlToLeft).Column
            Dim domainColIndex As Long
            domainColIndex = wsSource.Rows(1).Find(wsMatrix.Cells(1, j).Value, LookIn:=xlValues, LookAt:=xlWhole).Column
            If Application.CountIfs(wsSource.Columns(1), wsMatrix.Cells(i, 1).Value, wsSource.Columns(domainColIndex), "<>") > 0 Then
                wsMatrix.Cells(i, j).Value = "Y"
            End If
        Next j
    Next i
    
    ' 格式化矩阵
    With wsMatrix.UsedRange
        .Borders.LineStyle = xlContinuous
        .Rows(1).Font.Bold = True
        .Columns(1).Font.Bold = True
    End With
End Sub

2. 使用方法 #

• 运行宏：按Alt+F8选择UpdateIdeaDomainMatrix执行，即可生成/更新矩阵。
• 自动触发：若需数据刷新后自动更新，可在原始数据工作表的代码窗口添加Worksheet_Change事件（需根据实际刷新逻辑调整触发条件）。

注意事项 #

• 非VBA方案依赖Excel动态数组功能，仅支持365/2021及以上版本。
• 可根据实际数据结构调整公式或代码中的列位置、表头匹配文本。
• VBA方案需确保工作簿启用宏（保存为.xlsm格式）。

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