''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
