求VBA代码：取消合并单元格，填充单元格

novice2008 · 发表于 2010-3-20 09:29

有表格如下：
省       市
广东  广州
      深圳
      东莞
山东  济南
      青岛

先取消合并的单元格，然后再将这些单元格填充为之前的内容

省       市
广东广州
广东深圳
广东东莞
山东济南
山东青岛

如何编程实现？
谢谢！

alzeng · 发表于 2010-3-20 09:38

Sub ReWrt()
Dim Arr, k%
Arr = Range("A2", [B65536].End(3))
For k = 2 To UBound(Arr)
If Arr(k, 1) = "" Then Arr(k, 1) = Arr(k - 1, 1)
Next
[A:A].UnMerge
[A2].Resize(k - 1) = Arr
End Sub

复制代码

hyhhh · 发表于 2010-3-20 09:39

自己录制宏看看吧.
直接用录制的宏,估计可以.

zldccmx · 发表于 2010-3-20 09:46

   '撰写:老朽
   '网址:http://Club.ExcelHome.net
   '日期:2010-3-20 上午 09:46:43
Sub zldccmx()
Dim Rng As Range , V As Range
For Each Rng In UsedRange
      If Rng.MergeCells Then
         Set V = Rng.MergeArea
         Rng.MergeCells = False
         V.Value = Rng.Value
         V.HorizontalAlignment = xlCenter
      End If
Next
End Sub

zldccmx · 发表于 2010-3-20 09:59

不使用循环

   '撰写:老朽
   '网址:http://Club.ExcelHome.net
   '日期:2010-3-20 上午 09:58:43
Sub Cmx()
Dim Rng As Range
Set Rng = Range ("A2:A" & [a65536].End(xlUp).MergeArea.Offset(1).Row - 1)
Rng.UnMerge
Rng.SpecialCells(xlCellTypeBlanks) = "=" & Rng.SpecialCells(xlCellTypeBlanks)(1, 1).Offset(-1).Address(0, 0)
Rng.Copy: Rng.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End Sub

zldccmx · 发表于 2010-3-20 10:05

再来一段更简短的：

   '撰写:老朽
   '网址:http://Club.ExcelHome.net
   '日期:2010-3-20 上午 10:04:40
Sub Cmx()
With Range ("A2:A" & [a65536].End(3).MergeArea.Offset(1).Row - 1)
      .UnMerge
      .SpecialCells(4) = "=" & .SpecialCells(4)(1, 1).Offset(-1).Address(0, 0)
      .Value = .Value
End With
End Sub

alzeng · 发表于 2010-3-20 10:19

原帖由 zldccmx 于 2010-3-20 10:05 发表
再来一段更简短的：

   '撰写:老朽
   '网址:http://Club.ExcelHome.net
   '日期:2010-3-20 上午 10:04:40
Sub Cmx()
With Range ("A2:A" & [a65536].End(3).MergeArea.Offset(1).Row - 1)
...

还不够简短…… ^_^

Sub ReWrt()
With [A:A]
.UnMerge
.SpecialCells(4) = "=R[-1]C"
.Value = .Value
End With
End Sub

复制代码

[ 本帖最后由 alzeng 于 2010-3-20 10:20 编辑 ]

nawong · 发表于 2010-3-20 10:39

VBA+公式往往有奇效

zldccmx · 发表于 2010-3-20 10:40

原帖由 alzeng 于 2010-3-20 10:19 发表

还不够简短…… ^_^
Sub ReWrt()
With [A:A]
      .UnMerge
      .SpecialCells(4) = "=R[-1]C"
      .Value = .Value
End With
End Sub

哈哈，幸好我没有“谦虚”地说“我的是最简短的”，
我只是“谦虚”地说了一下“来一段更简短的”！

alzeng · 发表于 2010-3-20 10:42

玩笑，玩笑，问好朽大！

		自动登录	找回密码
密码			免费注册

[求助] 求VBA代码：取消合并单元格，填充单元格