[發問] 如何簡化程式

luke

各位大大

小弟錄製了兩個巨集
第1個巨集是將A:C欄去框線後整理
地2個巨集是把sheet1表A:C欄拷貝至sheet2表至定點, 然後清除資料
如下

煩請先進 大大指導簡化程式

Sub Line()
    Columns("A:C").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Font
        .Name = "新細明體"
        .FontStyle = "標準"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
        ActiveWindow.Panes(1).Activate
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub
Sub Clear()
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    sheet2.[A65536].End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Columns("A:C").Select
    Selection.ClearContents
    Range("A1").Select
End Sub

oobird

Sub Line()
   [a:c].Borders.LineStyle = 0
End Sub
Sub Clear()
   [a:c].Cut Sheet2.[a1]
End Sub

luke

回復 2# oobird


    謝謝oobird

    1. 我想將sheet1表A:C欄資料去除框線後,
         然後改字體為"新細明體" 和靠左排列

     2.sheet1表A:C欄整理後再將結果拷貝至sheet2表A欄最後一列的下方位置便清除sheet1表A:C欄內容
        (此資料列數量會變動即每次列數會不同)

         例如sheet1表有10列(A1:C10), 而sheet2表目前有3列(A1:C3), 需將sheet1表拷貝至sheet2表A4位置(如附件說明),
         下一次要拷貝至A14位置(依資料sheet1表資料列數量計算, 依次向下複製貼上

煩請先進 大大指導
TEST-15.rar (21.27 KB)

下載次數: 2

2012-5-2 21:41

Hsieh

回復 3# luke

1. Sub ex()
   
2. With sheet1
   
3.    With .Range("A1").CurrentRegion
   
4.    .Borders.LineStyle = xlNone
   
5.    .HorizontalAlignment = xlLeft
   
6.    .Font.Bold = False
   
7.    .Font.Name = "新細明體"
   
8.    .Font.FontStyle = "標準"
   
9.    .Font.Size = 12
   
10.    .Copy sheet2.[A1].End(xlDown).Offset(1)
    
11.    End With
    
12. End With
    
13. End Sub

複製代碼