Sub 合并内容()
    Dim rng As Range
    Dim cell As Range
    Dim mergedContent As String
    
    ' 获取当前框选的范围
    Set rng = Selection
    
    ' 遍历选定的单元格，合并内容并添加换行符
    mergedContent = ""
    For Each cell In rng
        If cell.Value <> "" Then
            If mergedContent = "" Then
                mergedContent = cell.Value
            Else
                mergedContent = mergedContent & vbNewLine & cell.Value
            End If
        End If
    Next cell
    
    ' 清空选定单元格的内容
    rng.ClearContents
    
    ' 合并选定单元格
    With rng
        .Merge
        .Value = mergedContent
        .WrapText = True ' 设置单元格内容自动换行
    End With
End Sub