ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何实时调整合并单元格列宽行高?

如何实时调整合并单元格列宽行高?

作者:绿色风 分类: 时间:2022-08-17 浏览:278
楼主
kevinchengcw
Q:如何实时调整合并单元格列宽行高?
A:合并单元格的行高及列宽无法自动调整适合,很多人为此苦恼不已,现给出一个简单的例子,可以通过worksheet_change事件,适当修改实现您的工作表中的合并单元格自动调整至适合的行高及列宽。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Dim M, N, I As Double
  3. Application.ScreenUpdating = False  '关闭屏幕刷新,提速又美观(暗箱操作)
  4. Application.EnableEvents = False  '关闭事件响应,防止连锁反应
  5. Application.DisplayAlerts = False  '关闭事件警告,耳根清静
  6. For M = Target.Row To Target.Row + Target.Rows.Count - 1  '防止为粘贴操作时有多个单元格,所以不管一个也好多个也好,全部用列举的方式一个一个来
  7.     Cells(M, 6).Select  '选中单元格,是为了进一步获得下面的单元格地址
  8.     If Selection.Address = "$F$" & M & ":$G$" & M Then   '判断单元格地址是不是我们本程序中要修改的单元格范围
  9.         Selection.UnMerge   '解除合并
  10.         Range(Cells(M, 6), Cells(M, 7)).Select  '选中原有单元格范围
  11.         With Selection   '设置跨列居中
  12.             .HorizontalAlignment = xlCenterAcrossSelection
  13.             .VerticalAlignment = xlCenter
  14.             .WrapText = True   '允许换行
  15.         End With
  16.         Columns(6).EntireColumn.AutoFit   '列宽自适应
  17.         Rows(M).EntireRow.AutoFit    '行高自适应
  18.         N = Rows(M).RowHeight    '取得行高值
  19.         I = Columns(6).ColumnWidth   '取得列宽值
  20.         With Selection  '再次合并单元格
  21.             .Merge
  22.             .HorizontalAlignment = xlGeneral
  23.         End With
  24.         Rows(M).RowHeight = N    '行高设定为取得的行高值
  25.         Columns("F:G").ColumnWidth = I  '列宽设定为取得的列宽值
  26.     End If
  27. Next M   '继续下一个
  28. Application.DisplayAlerts = True
  29. Application.EnableEvents = True
  30. Application.ScreenUpdating = True
  31. End Sub
通过一定的曲线操作,可以实现即时的合并单元格列宽及行高的自适应,活学活用,还能实现更多效果


附件为所举代码的示例文件
电气_6栋住宅.rar
2楼
xyf2210
先下载,在学习

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap