ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何用vba代码根据边框线合并单元格及单元格区域文本?

如何用vba代码根据边框线合并单元格及单元格区域文本?

作者:绿色风 分类: 时间:2022-08-17 浏览:90
楼主
kevinchengcw
Q: 如何用vba代码根据边框线合并单元格及单元格区域文本?
A: 代码如下:
  1. Sub test()
  2. Dim Rng As Range, R As Range, N&, I&, Str$
  3. For Each Rng In ActiveSheet.UsedRange   '循环使用区个个单元格
  4.     If Rng.Borders(xlEdgeTop).LineStyle <> xlNone And Rng.Borders(xlEdgeLeft).LineStyle <> xlNone And _
  5.         (Rng.Borders(xlEdgeBottom).LineStyle = xlNone Or Rng.Borders(xlEdgeRight).LineStyle = xlNone) Then  '如果单元格左侧及上方都有网格线而下方或右侧无网格线(即符合需合并区域左上角特征),则以该单元格为左上角,向右向下查找右下角特征单元格,从而确定合并区域
  6.         With Rng
  7.             For N = 0 To ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - .Column - 1
  8.                 If .Offset(, N).Borders(xlEdgeRight).LineStyle <> xlNone Then Exit For
  9.             Next N
  10.             For I = 0 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - .Row - 1
  11.                 If .Offset(I).Borders(xlEdgeBottom).LineStyle <> xlNone Then Exit For
  12.             Next I
  13.         End With
  14.         With Range(Rng, Rng.Offset(I, N))  '对于已找到的单元格区域范围,如果是两个以上的单元格,则
  15.             If .Cells.Count > 1 Then
  16.                 Application.DisplayAlerts = False  '关闭警告信息
  17.                 Str = ""  '初始化字符串变量为空
  18.                 For Each R In .Cells  '循环各个单元格串接单元格文本
  19.                     Str = Str & Trim(R.Value)
  20.                 Next R
  21.                 .Merge  '单元格区域合并
  22.                 .Value = Str  '合并后单元格区域的值等于串接后的文本
  23.                 Application.DisplayAlerts = True  '打开屏幕刷新
  24.             End If
  25.         End With
  26.     End If
  27. Next Rng
  28. End Sub
详见附件及素材源帖.
门窗表属性1.rar
2楼
成就滋味
学习了

免责声明

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

评论列表
sitemap