返回列表 上一主題 發帖

[發問] 如何簡化程式

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-5-2 20:25 | 只看該作者

[發問] 如何簡化程式

各位大大

小弟錄製了兩個巨集
第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
收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
277  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2012-5-2 21:50 | 只看該作者
回復 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
複製代碼
學海無涯_不恥下問

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
3#
發表於 2012-5-2 21:41 | 只看該作者
回復 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)

TOP

oobird
　頭銜: 街友一族

超級版主Rank: 8Rank: 8

帖子
1572 
主題
16 
精華
2 
積分
1521 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
150 
性別
男 
註冊時間
2010-5-1 
最後登錄
2016-1-13 

論壇貢獻勳章
2#
發表於 2012-5-2 20:47 | 只看該作者
Sub Line()
   [a:c].Borders.LineStyle = 0
End Sub
Sub Clear()
   [a:c].Cut Sheet2.[a1]
End Sub

TOP

        靜思自在 : 不怕事多，只怕多事。
返回列表 上一主題