''range.Merge 由指定的range对象创建合并单元格
Sub 合并单元格() Selection.Merge End Sub Sub 合并单元格实例() Dim Sint%, i%, rng As Range Application.DisplayAlerts = False '' 提示 Sint = Cells(Rows.Count, 1).End(xlUp).Row ''最后一列 For i = Sint To 2 Step -1 ''从下往上合并 Set rng = Range("a" & i) If rng = rng.Offset(-1) Then 'Range(rng, rng.Offset(-1)).Merge ''第一种方法 合并 rng.Offset(-1).Resize(2).Merge ''第二种方法 合并 End If Next End Sub 'range.mergeArea属性 '返回一个range对象 该对象代表包含指定单元格的合并区域 'range.unmerge 方法 '将合并单元格分级 Sub 统计合并单元格() a = Range("a1").MergeArea.Count ''统计已 A1单元格合并单元格的 单元格数量 Range("a1").UnMerge ''将合并的单元格分解 End Sub Sub 解除合并保持原来的数据() Dim b%, rng As Range For Each rng In Selection Sint = rng.address Bint = rng.MergeArea.Count rng.UnMerge rng.Resize(Bint) = rng.Value ''重新定位行数 向下Bint 行 Next End Sub ''comment 对象代表单元格批注 Sub 批注添加() With [a1] If .Comment Is Nothing Then ''没有批注 .AddComment "Current Sales" .Comment.Visible = False End If End With End Sub Sub 删除批注() Dim rng As Range For Each rng In Selection If Not rng.Comment Is Nothing Then ''有批注 rng.ClearComments End If Next End Sub Sub 批量添加批注() Dim rng As Range For Each rng In Range("a1:a20") rng.ClearComments If rng.Value > 90 Then rng.AddComment.text "优秀" End If Next End Sub Sub 批注修改() Range("a1").ClearComments Range("a1").AddComment ''添加批注 Range("a1").Comment.Shape.Height = 50 '设置批注高度 Range("a1").Comment.Shape.Width = 40 '设置批注宽度 Range("a1").Comment.Shape.Fill.UserPicture "D:\桌面文件\新图片\NBJ10.jpg" ''批注添加图片 Shape 图形的 Fill填充颜色 UserPicture用户自己的图片 Range("a1").Comment.Shape.Fill.UserPicture ThisWorkbook.Path & "\NBJ30.jpg" '' ThisWorkbook.Path 工作簿所在的目录 End Sub Sub 批量批注添加() Dim rng As Range For Each rng In Selection rng.ClearComments rng.AddComment rng.Comment.Shape.Height = 50 '设置批注高度 rng.Comment.Shape.Width = 40 '设置批注宽度 rng.Comment.Shape.Fill.UserPicture ThisWorkbook.Path & "\" & rng.Value & ".jpg" Next End Sub 'shapes 对象 '指定的工作表上的所有shap 对象的集合 '说明 每个shap 对象都代表绘图层的一个对象,如自选图形,任意多边形,图片 Sub abcshapes() Dim ob As Shape n = Sheet4.Shapes.Count For Each ob In Sheets(4).Shapes ''对工作表里的 图形集合进行循环 k = k + 1 Cells(k + 1, "f") = ob.name ''图形的名称 Cells(k + 1, "g") = ob.Type ''图形类型 Cells(k + 1, "h") = ob.Top ''顶端坐标 Cells(k + 1, "i") = ob.Left ''左端坐标 Cells(k + 1, "j") = ob.Width ''宽度 Cells(k + 1, "j") = ob.Height ''高度 Next End Sub Sub 图形插入() '''插入图片 地址 Sheet4.Shapes.AddPicture ThisWorkbook.Path & "\30.jpg", True, True, 100, 100, 70, 70 End Sub Sub 删除图形() Dim rng As Shape For Each rng In Shapes rng.Delete Next End Sub Sub 图片插入实例() Dim i As String For Each sp In Shapes If sp.Type <> 8 Then sp.Delete ''删除已存在的图形 End If Next For Each rng In Range("b1", Cells(Cells.Find("*", , , , , xlPrevious).Row, 2)) i = ThisWorkbook.Path & "\" & rng.Offset(0, -1).Value & ".jpg" ''图片名称跟单元格A列一样 Set rngs = Cells(rng.Row, 2) ''把要插入图片的单元格状态赋值 Sheet4.Shapes.AddPicture i, True, True, rngs.Left, rngs.Top, rngs.Width, rngs.Height Next End Sub ''综合运用() Sub 多表合并() Dim i As Integer, rss As Integer, st As Worksheet, zst As Worksheet Set zst = Sheets() End Sub Sub 多表合并() Dim i As Integer, rs As Integer, rss As Integer, st As Worksheet, zst As Worksheet Set zst = Sheets("统计") For i = 1 To 3 Set st = Sheets(i) ''表变量 'rs = st.UsedRange.Row.Count ' rss = zst.UsedRange.Row.Count rs = st.Cells.Find("*", , , , , xlPrevious).Row ''来源表有多少行 rss = zst.Cells.Find("*", , , , , xlPrevious).Row ''目标表的行数 st.Range("A2:B" & rs).Copy zst.Range("A" & rss + 1) zst.Cells(rss + 1, 3).Resize(rs - 1) = i & "月" ''RS其中有列是列名 Next End Sub |
|
来自: 时间剧毒 > 《学习资料_Execl》