Excel VBA需求：基于关键词提取数据列唯一值并自动更新

VBA后台自动实现方案（无需用户手动操作） #

这个方案会在Reporting表的B2单元格内容变更时，自动从Data表N列提取以B2关键词开头的唯一值，写入B12开始的区域。

操作步骤（仅需一次设置） #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器
2. 在左侧的工程资源管理器里找到Reporting工作表（对应Sheet1），双击它打开代码窗口
3. 把下面的代码粘贴进去，关闭VBA编辑器
4. 把文件另存为**启用宏的工作簿（.xlsm）**格式，以后打开时启用宏即可

VBA代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只监控B2单元格的变更
    If Target.Address <> "$B$2" Then Exit Sub
    
    Dim wsData As Worksheet
    Dim wsReport As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim uniqueValues As Collection
    Dim keyWord As String
    Dim i As Integer
    
    ' 初始化工作表对象
    Set wsReport = ThisWorkbook.Worksheets("Reporting")
    Set wsData = ThisWorkbook.Worksheets("Data")
    Set uniqueValues = New Collection
    
    ' 获取B2的关键词，转为小写避免大小写敏感（可根据需求删除LCase）
    keyWord = LCase(wsReport.Range("B2").Value)
    If keyWord = "" Then
        ' 如果B2为空，清空B12开始的区域
        wsReport.Range("B12:B" & wsReport.Cells(wsReport.Rows.Count, "B").End(xlUp).Row).ClearContents
        Exit Sub
    End If
    
    ' 获取Data表N列的最后一行
    lastRow = wsData.Cells(wsData.Rows.Count, "N").End(xlUp).Row
    
    ' 遍历Data表N列，收集匹配开头的唯一值
    On Error Resume Next ' 忽略重复值添加的错误
    For Each cell In wsData.Range("N2:N" & lastRow) ' 从N2开始，跳过表头（如果有）
        If cell.Value <> "" Then
            If LCase(Left(cell.Value, Len(keyWord))) = keyWord Then
                uniqueValues.Add cell.Value, Key:=CStr(cell.Value)
            End If
        End If
    Next cell
    On Error GoTo 0 ' 恢复错误处理
    
    ' 清空Reporting表B12开始的旧数据
    wsReport.Range("B12:B" & wsReport.Cells(wsReport.Rows.Count, "B").End(xlUp).Row).ClearContents
    
    ' 将收集到的唯一值写入B12开始的区域
    For i = 1 To uniqueValues.Count
        wsReport.Range("B11").Offset(i, 0).Value = uniqueValues(i)
    Next i
End Sub

代码说明 #

• 仅当Reporting表的B2单元格内容变化时才触发执行，避免不必要的计算
• 自动忽略大小写匹配（如果需要严格大小写，删除代码中的LCase函数即可）
• 自动跳过空单元格，只收集非空的匹配值
• 自动清空之前的结果，避免旧数据残留
• 保存为.xlsm格式后，每次打开文件启用宏就会自动生效，无需用户额外操作

备选：动态数组公式方案（无需宏） #

如果你的Excel版本是365/2021及以上，也可以用动态数组公式实现，无需VBA：
在Reporting表的B12单元格输入以下公式，按回车即可自动扩展结果：

=UNIQUE(FILTER(Data!N:N, LEFT(Data!N:N, LEN(B2))=B2, ""))

注意：如果B2为空，公式会返回Data表N列所有唯一值，可根据需求调整。

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