如何用类VLOOKUP功能的VBA代码复制Excel多选下拉列表格式？

问题背景 #

已通过VBA实现Excel下拉列表多选功能，选中的多个选项以vbCrLf作为分隔符在单元格内分行显示；但使用原生VLOOKUP函数引用该单元格时，换行符丢失，所有选项被合并为一行，无法保留原有的分行格式。

自定义VBA函数实现 #

通过编写自定义VBA函数，替代原生VLOOKUP，同时保留目标单元格的换行格式：

1. 打开Excel，按Alt+F11打开VBA编辑器
2. 右键当前工作簿，选择「插入」→「模块」
3. 在模块中粘贴以下代码：

Function VLOOKUPKeepFormat(lookupVal As Variant, lookupRange As Range, returnCol As Integer, exactMatch As Boolean) As String
    Dim matchCell As Range
    ' 在查找区域的第一列定位匹配项
    Set matchCell = lookupRange.Columns(1).Find( _
        What:=lookupVal, _
        LookIn:=xlValues, _
        LookAt:=IIf(exactMatch, xlWhole, xlPart), _
        MatchCase:=False)
    
    If Not matchCell Is Nothing Then
        ' 返回匹配单元格的文本内容（包含vbCrLf换行符）
        VLOOKUPKeepFormat = matchCell.Offset(0, returnCol - 1).Text
    Else
        ' 无匹配结果时返回空字符串
        VLOOKUPKeepFormat = ""
    End If
End Function

使用方法 #

在需要引用的单元格中输入公式，用法和原生VLOOKUP完全一致：

=VLOOKUPKeepFormat(查找值, 查找区域, 返回列数, 是否精确匹配)

例如：=VLOOKUPKeepFormat(A1, $C$1:$D$10, 2, TRUE)

关键设置：给公式所在单元格开启「自动换行」（右键单元格→「设置单元格格式」→「对齐」→勾选「自动换行」），确保换行符生效显示。

扩展说明 #

如果需要保留更多单元格格式（如字体颜色、背景色等），可以修改为事件触发的子过程，示例如下（以工作表Change事件为例，当指定单元格更新时同步格式）：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lookupVal As Variant
    Dim matchCell As Range
    Dim lookupRange As Range
    
    ' 定义需要触发的目标单元格（比如E列）
    If Not Intersect(Target, Me.Range("E:E")) Is Nothing Then
        lookupVal = Target.Value
        Set lookupRange = Me.Range("C1:D10") ' 查找区域
        
        Set matchCell = lookupRange.Columns(1).Find(What:=lookupVal, LookIn:=xlValues, LookAt:=xlWhole)
        If Not matchCell Is Nothing Then
            ' 复制匹配单元格的内容和格式到目标单元格
            matchCell.Offset(0, 1).Copy
            Target.PasteSpecial Paste:=xlPasteAll
            Application.CutCopyMode = False
        End If
    End If
End Sub

将此代码粘贴到目标工作表的代码窗口中，即可在E列单元格输入查找值时，自动同步匹配单元格的全部内容和格式。

内容的提问来源于stack exchange，提问作者N.Dang2