求助：批量将Excel指定列内容按格式合并的VBA代码

以下是实现需求的通用VBA代码，可批量将原工作表的B、F、M列内容按指定格式合并到新工作表：

Sub MergeColumnsWithFormat()
    Dim wsOriginal As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim bText As String, fText As String, mText As String
    Dim targetCell As Range
    
    ' 指定原工作表（可根据实际修改名称）
    Set wsOriginal = ThisWorkbook.Worksheets("Sheet1")
    ' 创建新工作表并命名
    Set wsNew = ThisWorkbook.Worksheets.Add
    wsNew.Name = "合并结果"
    
    ' 获取原表最后一行行号
    lastRow = wsOriginal.Cells(wsOriginal.Rows.Count, "B").End(xlUp).Row
    
    ' 循环遍历所有数据行（从第2行开始，假设第1行是表头）
    For i = 2 To lastRow
        bText = wsOriginal.Cells(i, "B").Value
        fText = wsOriginal.Cells(i, "F").Value
        mText = wsOriginal.Cells(i, "M").Value
        
        ' 跳过空行（如果B列无内容则跳过）
        If bText = vbNullString Then GoTo NextRow
        
        ' 合并内容到新工作表对应行的A列
        Set targetCell = wsNew.Cells(i, "A")
        targetCell.Value = "(" & bText & ")" & fText & vbCrLf & mText
        ' 设置自动换行
        targetCell.WrapText = True
        
        ' 设置B列内容（带括号）为粗体
        targetCell.Characters(Start:=1, Length:=Len(bText) + 2).Font.Bold = True
        ' 设置M列内容为斜体
        targetCell.Characters(Start:=Len(bText) + Len(fText) + 3, Length:=Len(mText)).Font.Italic = True
        
NextRow:
    Next i
    
    ' 调整新工作表列宽以适配内容
    wsNew.Columns("A").AutoFit
    MsgBox "合并完成！结果已保存到「合并结果」工作表", vbInformation
End Sub

代码关键点说明： #

• 自动获取原表数据的最后一行，无需手动指定行数，适配不同数据量
• 跳过B列为空的行，避免无效内容
• 通过Characters方法精准控制不同部分的格式：
  • 第1部分：从开头到Len(bText)+2（包含括号）设置为粗体
  • 第3部分：从Len(bText)+Len(fText)+3（跳过括号、B内容、F内容和换行符）开始设置为斜体
• 自动开启单元格自动换行并调整列宽，优化显示效果
• 可修改wsOriginal的工作表名称以适配你的实际表格

使用方法： #

1. 打开目标Excel文件，按下Alt+F11打开VBA编辑器
2. 插入新模块（右键工作簿→插入→模块）
3. 将上述代码粘贴到模块中
4. 运行宏（按下F5或在Excel界面通过「开发工具」→「宏」选择运行）

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