Excel VBA之合并单元格操作-叶海峰
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


Excel VBA之合并单元格操作

发表时间:2012/8/8 9:01:26 评论(3) 浏览(21420)  评论 | 加入收藏 | 复制
   
摘 要:Excel VBA之合并单元格操作。
正 文:

Sub mergecells()     '自动合并单元格
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim cell   As Range
    Dim i, b   As Integer
    i = Selection.Rows.count - 1
    For b = 1 To i
        With ActiveCell
            .Select
            If .Offset(1, 0) = .Value Then
                Range(ActiveCell, .Offset(1, 0)).Select
                Selection.mergecells = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            Else
                .Offset(1, 0).Select
            End If
        End With
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub


Sub mergecells_insertvalue()    '自动拆分合并单元格+填充值
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo tuichu
    Dim cell   As Range
    Dim i, a   As Integer  '填充上一行值
    Dim j, k   As Byte
    Dim rng    As String
    i = Selection.Rows.count
    k = Selection.Columns.count
    For Each cell In Selection
        If cell.mergecells = True Then
            cell.mergecells = False
        End If
    Next
    rng = ActiveCell.Address
    For j = 0 To k - 1
        For a = 1 To i
            With ActiveCell
                If .Value = "" Then
                    .Offset(-1, 0).Copy
                    .PasteSpecial xlPasteAll
                End If
                .Offset(1, 0).Select
            End With
        Next
        Range(rng).Offset(0, j + 1).Activate
    Next

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
tuichu:
End Sub


Sub 拆分合并单元格_填充平均值()
    Dim ma     As Range
    Dim a      As Variant
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each rng In Selection
        a = rng.Value
        If rng.mergecells = True Then
            Set ma = rng.MergeArea
            rng.mergecells = False
            Range(ma.Address) = a / ma.Cells.count
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub


演   :


Access软件网交流QQ群(群号:198465573)
 
 相关文章
单元格/单元格区域-EXCEL的VBA  【helo  2008/1/17】
[access报表]报表仿Execl合并单元格;Access报表合...  【wj.s  2010/6/28】
合并单元格的查找问题  【欢乐小爪  2012/12/3】
求合并单元格的数量  【欢乐小爪  2012/12/4】
Access窗体仿合并单元格;Access窗体合并单元格示例  【小核桃  2018/7/4】
常见问答
技术分类
相关资源
文章搜索
关于作者

叶海峰

文章分类

文章存档

友情链接