【EXCEL 向下合并制定列的空缺内容】

打印 上一主题 下一主题

主题 905|帖子 905|积分 2715

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

使用道具 举报

0 个回复

倒序浏览

快速回复

您需要登录后才可以回帖 登录 or 立即注册

本版积分规则

科技颠覆者

金牌会员
这个人很懒什么都没写!
快速回复 返回顶部 返回列表