Sub MergeSameCells()

Dim ws As Worksheet

Dim selectedCol As String

Dim lastRow As Long, i As Long, startRow As Long

Dim mergeRange As Range

Set ws = ActiveSheet

' 获取选中列的字母 (默认取选区第一列)

On Error Resume Next

selectedCol = Split(Selection.Columns(1).Address(, 0), ":")(0)

On Error GoTo 0

' 若未选中有效列则使用B列

If selectedCol = "" Then selectedCol = "B"

lastRow = ws.Cells(ws.Rows.Count, selectedCol).End(xlUp).Row

startRow = 2 ' 从第2行开始（跳过标题）

Application.DisplayAlerts = False ' 关闭合并提示

' 遍历所有行（包含最后一行+1的虚拟行）

For i = startRow To lastRow + 1

' 最后一行时强制触发合并

If i > lastRow Then

Set mergeRange = ws.Range(selectedCol & startRow & ":" & selectedCol & (i - 1))

If mergeRange.Cells.Count > 1 Then mergeRange.Merge

Exit For

End If

' 检测值变化时合并

If ws.Cells(i, selectedCol).Value <> ws.Cells(i + 1, selectedCol).Value Then

Set mergeRange = ws.Range(selectedCol & startRow & ":" & selectedCol & i)

If mergeRange.Cells.Count > 1 Then mergeRange.Merge

startRow = i + 1

End If

Next i

Application.DisplayAlerts = True

End Sub

```

主要优化点：

1. 动态列选择

- 通过 `Selection.Columns(1).Address` 获取选中列的字母

- 支持多列选区（自动取第一列）

- 未选列时默认使用B列

2. 修复合并缺陷

- 添加虚拟行(`lastRow+1`)确保最后一段相同值被合并

- 使用 `Range.Cells.Count > 1` 避免单单元格合并

3. 合并逻辑优化

- 引入 `mergeRange` 对象变量提高可读性

- 使用字符串拼接构建动态列范围

- 添加错误处理防止空选区报错

4. 性能改进

- 保持 `Application.DisplayAlerts = False` 状态

- 仅当实际需要合并时执行合并操作

使用说明：

1. 运行前先选中需要合并的列

2. 自动跳过标题行（从第2行开始）

3. 合并后仅保留左上角单元格的值

4. 支持任意列数据（包括超过B列的范围）

> 注意事项：合并单元格可能导致数据排序/筛选异常，建议在数据最终处理阶段使用此功能。如需保留合并前的所有数据，请先备份工作表。