请问如何将当前工作表中所有的矩形组合起来？

panwen2001

excel表单中有好几百个矩形，需要组合在一起方便以后拷贝，要是手动选取组合估计要把手和眼睛都累残-_-

大侠们有好的方法自动组合吗？谢谢了！

zhaogang1960

“矩形”是单独的连续数据矩形区域？如果是：

1. Sub Macro1()
   
2.     Dim c As Range, rng As Range, d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each c In ActiveSheet.UsedRange
   
5.         If c.Value <> "" Then
   
6.             If Not d.Exists(c.CurrentRegion.Address) Then
   
7.                 d(c.CurrentRegion.Address) = ""
   
8.                 If rng Is Nothing Then Set rng = c.CurrentRegion Else Set rng = Union(rng, c.CurrentRegion)
   
9.             End If
   
10.         End If
    
11.     Next
    
12.     If Not rng Is Nothing Then rng.Select
    
13. End Sub
    

复制代码

panwen2001

zhaogang1960 发表于 2012-2-7 09:37
“矩形”是单独的连续数据矩形区域？如果是：

11.rar (36.44 KB, 下载次数: 9)

2012-2-7 09:45 上传

点击文件名下载附件

额 不是的 不好意思 没说清楚

是附件中表格下方的那些矩形自选图形 想把这些小矩形块组合在一起

zhaogang1960

panwen2001 发表于 2012-2-7 09:47
额 不是的 不好意思 没说清楚

是附件中表格下方的那些矩形自选图形 想把这些小矩形块组合在一起

没有看懂，不好意思

panwen2001

怎么说呢。。。

就是表格下方的那些绿色、黑色、黄色、灰色的小矩形方块，有2、3百块排列在一起的，想把这些小方块组合成一个图形，不知道说清楚没有？

wxhnr

用“绘图”工具栏上的光标按钮画个选择区域就可以选择多个对象了。

yjh_27

"原始数据文件不存在"

Selection.ShapeRange.Group.Select

panwen2001

太感谢了！！

香川群子

1. Sub test1()
   
2.     Dim shp As Shape, str
   
3.    
   
4.     For Each shp In ActiveSheet.Shapes
   
5.         If shp.Type = msoGroup Then '6
   
6.             shp.Ungroup
   
7.             Exit Sub
   
8.         End If
   
9.     Next
   
10.     For Each shp In ActiveSheet.Shapes
    
11.         If shp.Type <> msoFormControl Then '8
    
12.             str = str & "," & shp.Name
    
13.         End If
    
14.     Next
    
15. '    sr = Split(Mid(str, 2), ",")
    
16.     ActiveSheet.Shapes.Range(Split(Mid(str, 2), ",")).Group.Select
    
17.     Selection.Placement = xlFreeFloating '3
    
18. '    Selection.Placement = xlMove
    
19. '    Selection.Placement = xlMoveAndSize
    
20. End Sub

复制代码

ty1014

香川群子 发表于 2018-7-23 16:06

又见美女出手啊