[已解决]麻烦看看可以简化代码吗？

乐乐2006201506

麻烦哪位老师帮帮忙（前几天自己录制的宏代码有些长，不过自己终于简化到这个程度了），希望还能简化。
       谢绝灌水，谢绝说风凉话！请理解，谢谢！
Sub 工资表设置07版简化()
    Range("A1").Select
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy
    Range("A:B,E:E,H:J,P:P,W:W,Z:Z,AB:AB,AF:AH,AL:AL,AO:AO").Select
    Selection.Delete
    Range("AO1").Activate
    Range("A1:Z1").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = True
    .Borders.Weight = 2
End With
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "序号"
    Range("A2").Select
    Range("A2") = "1"
    Range("A3") = "2"
    Range("A2:A3").Select
    Selection.AutoFill Destination:=Range("A2:A244")
    Range("A2:A244").Select
    Columns("B:B").Select
    Selection.Copy
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Columns("A:AA").AutoFit
    Range("A1").Select
    [S:S].ColumnWidth = 11.38   
    Application.CutCopyMode = False
With Range("A2:AA244")
    .Borders.Weight = 2
    .RowHeight = 22.5
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
With Range("A1:AA1")          '这个"A1:AA1"和下一个with中的"A1:AA1"形式一样，但实际行数不同，因为插入了一行。
    .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With
With Range("A1:AA1")
    .RowHeight = 42.75
    .Merge
    .Font.Name = "黑体"
    .Font.Size = 26
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Value = "表"
End With
With Range("A2:AA2")
    .RowHeight = 36
End With
With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$2"
    .PrintArea = "A1:AA245"
    .CenterFooter = "第 &P 页，共 &N 页"
    .LeftMargin = Application.InchesToPoints(0.551181102362205)
    .RightMargin = Application.InchesToPoints(0.551181102362205)
    .TopMargin = Application.InchesToPoints(0.78740157480315)
    .BottomMargin = Application.InchesToPoints(0.78740157480315)
    .HeaderMargin = Application.InchesToPoints(0.511811023622047)
    .FooterMargin = Application.InchesToPoints(0.511811023622047)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .CenterHorizontally = True
    .CenterVertically = False
    .Orientation = xlLandscape
    .Draft = False
    .PaperSize = xlPaperA3
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 71
    .PrintErrors = xlPrintErrorsDisplayed
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
End With
MsgBox "表设置完成"
End Sub

最佳答案

月排行榜 / 总排行榜

爱疯

2016-5-7 23:24

Option Explicit

Sub 工资表设置07版简化()
    Sheets("Sheet1").Select

    Range("A:B,E:E,H:J,P:P,W:W,Z:Z,AB:AB,AF:AH,AL:AL,AO:AO").Delete

    With Range("A1:Z1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Borders.Weight = 2
    End With

    Columns("A:A").Insert
    Range("A1") = "序号"
    Range("A2") = 1
    Range("A2").AutoFill Destination:=Range("A2:A224"), Type:=xlFillSeries

    Columns("B:B").Copy
    Columns("A:A").PasteSpecial Paste:=xlPasteFormats
    Columns("A:AA").AutoFit
    [S:S].ColumnWidth = 11.38

    With Range("A2:AA244")
        .Borders.Weight = 2
        .RowHeight = 22.5
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Range("A1:AA1").Insert
    With Range("A1:AA1")
        .RowHeight = 42.75
        .Merge
        .Font.Name = "黑体"
        .Font.Size = 26
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Value = "表"
    End With
    Range("A2:AA2").RowHeight = 36

    '页面设置：纸张为A3，横向，缩放比例为72%；页边距为上下均为2，左右均为1.4，同时设置打印时纸张内容水平居中；页脚为第一页共几页格式；表头为第一二行。
    '注释一句或几句，没问题就继续注释，有问题就取消看帮助。
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2" '保留
        .PrintArea = "A1:AA245"
        .CenterFooter = "第 &P 页，共 &N 页"
        .LeftMargin = Application.InchesToPoints(0.551181102362205)
        .RightMargin = Application.InchesToPoints(0.551181102362205)
        .TopMargin = Application.InchesToPoints(0.78740157480315)
        .BottomMargin = Application.InchesToPoints(0.78740157480315)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3 '保留
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 71
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With

    Application.CutCopyMode = False
    MsgBox "表设置完成"

End Sub

跳转到最佳答案楼层

爱疯

Sub 复制()
    Range("A1").Copy Range("B1")
End Sub

Sub 剪切()    '剪切后插入
    Columns("D:D").Cut
    Columns("B:B").Insert          '剪切后粘贴
    Columns("D:D").Cut Columns("B:B")
End Sub

Sub 删除()
    Range("A:A,C:E").Delete
End Sub

Sub 选择性粘贴()
    Range("A1").Copy    '复制A1
    Range("B1").PasteSpecial Paste:=xlPasteValues    '在B1选择性粘贴为数值
End Sub

Sub 替换()    'A1:A5中,1替换为2,完整匹配
    Range("A1:A5").Replace What:=1, Replacement:=2, LookAt:=xlWhole
End Sub







建议：
1）以上是几种常见操作。（要用的但没找到的操作，再单独求助）
2）一个个操作的精简
3）最终把1楼的录制宏，逐渐改成下面的类似效果。







Sub test()

    ''''''''''''''''''''''''''''
    '比如第1个，是复制并粘贴
   
   
    ''''''''''''''''''''''''''''
    '比如第2个，是剪切并插入
   
   
    ''''''''''''''''''''''''''''
    '比如第N个，是设置单元格格式
   
   
End Sub

爱疯

修改（或者说精简）录制宏的过程，就是这样单调、一个操作接一个操作的改动过程。

乐乐2006201506

爱疯 发表于 2016-5-7 21:01
修改（或者说精简）录制宏的过程，就是这样单调、一个操作接一个操作的改动过程。

谢谢您的指导，你每次都很热心，我很感激。希望您能够将我上面的代码按照你的思路完整的写出来，谢谢！

爱疯

Option Explicit

Sub 工资表设置07版简化()
    Sheets("Sheet1").Select

    Range("A:B,E:E,H:J,P:P,W:W,Z:Z,AB:AB,AF:AH,AL:AL,AO:AO").Delete

    With Range("A1:Z1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Borders.Weight = 2
    End With

    Columns("A:A").Insert
    Range("A1") = "序号"
    Range("A2") = 1
    Range("A2").AutoFill Destination:=Range("A2:A224"), Type:=xlFillSeries

    Columns("B:B").Copy
    Columns("A:A").PasteSpecial Paste:=xlPasteFormats
    Columns("A:AA").AutoFit
    [S:S].ColumnWidth = 11.38

    With Range("A2:AA244")
        .Borders.Weight = 2
        .RowHeight = 22.5
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Range("A1:AA1").Insert
    With Range("A1:AA1")
        .RowHeight = 42.75
        .Merge
        .Font.Name = "黑体"
        .Font.Size = 26
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Value = "表"
    End With
    Range("A2:AA2").RowHeight = 36

    '页面设置：纸张为A3，横向，缩放比例为72%；页边距为上下均为2，左右均为1.4，同时设置打印时纸张内容水平居中；页脚为第一页共几页格式；表头为第一二行。
    '注释一句或几句，没问题就继续注释，有问题就取消看帮助。
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2" '保留
        .PrintArea = "A1:AA245"
        .CenterFooter = "第 &P 页，共 &N 页"
        .LeftMargin = Application.InchesToPoints(0.551181102362205)
        .RightMargin = Application.InchesToPoints(0.551181102362205)
        .TopMargin = Application.InchesToPoints(0.78740157480315)
        .BottomMargin = Application.InchesToPoints(0.78740157480315)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3 '保留
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 71
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With

    Application.CutCopyMode = False
    MsgBox "表设置完成"

End Sub

爱疯

比起得到结果来说，学着自己看帮助，自己改，更重要。

乐乐2006201506

估计再没有可以简化的地方了，谢谢您了，只是第一步我自己加上就成，我要的不是在原来表格中修改，而是在新的里面修改，本来还要保存在桌面上的，能不能麻烦您在这段代码后边加上，给我发一下，谢谢！

乐乐2006201506

爱疯 发表于 2016-5-7 23:24
Option Explicit

Sub 工资表设置07版简化()

今天能得到各位老师的热心帮助，心里感觉暖暖的，不像前几次，由于是录制的宏，没有人理我，心里真的有些无助，也有些凄凉！再次谢谢各位老师了。