alt + F11 开始编写VBA脚本
alt + F8 实行 选中MergeAndFillDownWithoutReMerge 实行合并
- Sub MergeAndFillDownWithoutReMerge()
- Dim ws As Worksheet
- Dim cell As Range
- Dim lastRow As Long, currentRow As Long
- Dim startCell As Range, mergeRange As Range
-
- ' 设置工作表
- Set ws = ActiveSheet
-
- ' 获取选中列的最后一行
- lastRow = ws.Cells(ws.Rows.Count, Selection.Column).End(xlUp).Row
-
- ' 从下往上遍历选中的列以避免合并后影响后续判断
- For currentRow = lastRow To 1 Step -1
- Set cell = ws.Cells(currentRow, Selection.Column)
-
- ' 检查当前单元格是否已被合并
- If Not cell.MergeCells Then
- If IsEmpty(cell.Value) Then
- ' 找到第一个非空的上一个单元格
- Set startCell = cell.End(xlUp)
-
- ' 如果startCell不是cell本身(即cell不是第一行)并且未被合并
- If Not startCell.Address = cell.Address And Not startCell.MergeCells Then
- ' 创建合并范围
- Set mergeRange = ws.Range(startCell, cell)
-
- ' 填充空白单元格
- startCell.Copy
- mergeRange.PasteSpecial Paste:=xlPasteAll
-
- ' 合并单元格
- With mergeRange
- .Merge
- .VerticalAlignment = xlCenter
- .HorizontalAlignment = xlCenter
- End With
- End If
- End If
- End If
- Next currentRow
-
- ' 清除剪贴板
- Application.CutCopyMode = False
- End Sub
复制代码 免责声明:如果侵犯了您的权益,请联系站长,我们会及时删除侵权内容,谢谢合作!更多信息从访问主页:qidao123.com:ToB企服之家,中国第一个企服评测及商务社交产业平台。 |