使合并的单元格都有内容

superfeng

受启发了

dj-1621

辛苦了

冲浪世界

呵呵,好方法[em17]

冲浪世界

楼主的方法能录制成宏吗,不管横着的,竖着的,有几个单元格合并都能用这个宏?[em06]

aichong

QUOTE:

以下是引用冲浪世界在2007-8-7 9:37:57的发言：
楼主的方法能录制成宏吗,不管横着的,竖着的,有几个单元格合并都能用这个宏?[em06]

不错的建议！就是说：原先合并的单元格中只有一个单元格有内容，执行这个宏后，就使得每个单元格都有相同的内容，以便于以后的计算。

或者：原先单元格并没有合并，合并后使得每个单元格都有相同的内容。

[此贴子已经被作者于2007-8-7 10:27:23编辑过]

纤纤素手

很实用,前段时间正为这个烦恼类,谢谢版主分享.

一意孤行

QUOTE:

以下是引用冲浪世界在2007-8-7 9:37:57的发言：
楼主的方法能录制成宏吗,不管横着的,竖着的,有几个单元格合并都能用这个宏?[em06]

选中合并单元格后运行下面的宏。

Sub 填充合并单元格()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Selection.Copy
        Old_Sheet = ActiveSheet.Name
        Sheets.Add '添加一个临时表用于转换数据
        ActiveSheet.Paste '将合并单元格格式粘贴到新的临时表中
        New_Sheet = ActiveSheet.Name
        Sheets(Old_Sheet).Select
        ActiveCell.UnMerge '取消合并
        Selection.FillDown '列方向填充数据
        Selection.FillRight '行方向填充数据
        Sheets(New_Sheet).Select
        Selection.Copy
        Sheets(Old_Sheet).Select
        Selection.PasteSpecial Paste:=xlPasteFormats '刷回原来的合并格式
        Application.CutCopyMode = False
        Sheets(New_Sheet).Delete '使用完后删除临时表
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

PS：特别提醒，一次只能解决一个合并单元格。选了多个合并单元格会出错。

[此贴子已经被作者于2007-8-7 11:54:11编辑过]

xxhacker

太强了，学习了

xxhacker

太实用了，再次感谢！！

gvntw

选定单元格区域，运行宏后，合并，所有单元格内容为选定的左上角单元格的内容：

Option Explicit

Sub MyMerge()
    Dim rg As Range
    Dim Mrg As Range
    Dim con, TempSh As Worksheet
    Dim strA As String
   
    Set Mrg = Selection
    con = Mrg.Cells(1, 1).Value '取选定区域左上角单元格的内容
    Mrg.Value = con
    strA = Mrg.Address
   
    Set TempSh = Sheets.Add     '添加一个临时工作表
    TempSh.Range(strA).Merge    '合并区域
    TempSh.Range(strA).Copy     '复制
    Mrg.PasteSpecial xlPasteFormats     '选择性粘贴格式
   
    Application.DisplayAlerts = False
    TempSh.Delete           '删除临时工作表
    Application.DisplayAlerts = True
End Sub