[已解决]一个单元装入二个单元中成合并状态

张雄友

一个单元装入二个单元中成合并状态.

最佳答案

月排行榜 / 总排行榜

dsmch

2014-8-20 05:21

1. Sub Macro1()
   
2. Dim arr, brr, rng As Range, i&, n&
   
3. arr = Range("b8").CurrentRegion
   
4. ReDim brr(1 To UBound(arr) * 2, 1 To 1)
   
5. For i = 1 To UBound(arr)
   
6.     brr(2 * i - 1, 1) = arr(i, 1)
   
7. Next
   
8. Set rng = Application.InputBox("请用鼠标选择顶点单元格", Type:=8)
   
9. n = UBound(brr)
   
10. rng.Resize(n).Clear
    
11. rng.Resize(n) = brr
    
12. With rng.Resize(2)
    
13.     .Merge
    
14.     .Copy
    
15. End With
    
16. Cells(rng.Row + 2, rng.Column).Resize(n - 2).PasteSpecial Paste:=xlPasteFormats
    
17. rng.Resize(n).Borders().Weight = xlThin
    
18. Application.CutCopyMode = False
    
19. End Sub

复制代码

跳转到最佳答案楼层

su45

如果要用合并单元格，用数组就不行了，除非你事先已合并了单元格，就像你的 H 列那样，你的代码就可以。如果目的区域事先没合并那你的代码就不行了，也不能用数组，而是每个单元格先合并后赋值。

pengyx

最后一句写入“Range("J5").Resize(UBound(brr, 1), 1) = brr”不要哈
在next的后面加上如下代码：
For j = 1 To UBound(brr) Step 2
    Range("j" & j + 4) = brr(j, 1)
    Range("j" & j + 4 & ":j" & j + 5).Merge
Next
见附件

张雄友

pengyx 发表于 2014-8-19 21:15
最后一句写入“Range("J5").Resize(UBound(brr, 1), 1) = brr”不要哈
在next的后面加上如下代码：
For j ...

For j = 1 To UBound(brr) Step 2
这句写得好。但下面二句的表达方式很死板。

    Range("j" & j + 4) = brr(j, 1)
    Range("j" & j + 4 & ":j" & j + 5).Merge

su45

按你的原意思改的：

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, rng As Range, i&, n&
   
3. arr = Range("b8").CurrentRegion
   
4. ReDim brr(1 To UBound(arr) * 2, 1 To 1)
   
5. For i = 1 To UBound(arr)
   
6.     brr(2 * i - 1, 1) = arr(i, 1)
   
7. Next
   
8. Set rng = Application.InputBox("请用鼠标选择顶点单元格", Type:=8)
   
9. n = UBound(brr)
   
10. rng.Resize(n).Clear
    
11. rng.Resize(n) = brr
    
12. With rng.Resize(2)
    
13.     .Merge
    
14.     .Copy
    
15. End With
    
16. Cells(rng.Row + 2, rng.Column).Resize(n - 2).PasteSpecial Paste:=xlPasteFormats
    
17. rng.Resize(n).Borders().Weight = xlThin
    
18. Application.CutCopyMode = False
    
19. End Sub

复制代码