12
返回列表 上一主題 發帖

請簡化錄製的程式碼

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2021-7-23 12:49 | 只看該作者

請簡化錄製的程式碼

本帖最後由 ziv976688 於 2021-7-23 12:51 編輯

'複製指定的DATA!A:I範圍，貼上6個工作表的AU2
Sheets("DATA").Range("A1850:I1875").Select
        Selection.Copy
        Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8")).Select
        .Range("AU2").Select
        ActiveSheet.Paste
謝謝 !
收藏 分享

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
2#
發表於 2021-7-23 15:29 | 只看該作者
不好意思，漏了2列
'複製指定的DATA!A:I範圍，貼上6個工作表的AU2
Sub Macro1()
    Range("A1850:I1875").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8")).Select
    Sheets("準3進4").Activate
    Range("AU2").Select
    ActiveSheet.Paste
End Sub

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
3#
發表於 2021-7-23 15:49 | 只看該作者
回復 2# ziv976688

Sub test()
    For Each xs In Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))
        Sheets("DATA").Range("A1850:I1875").Copy xs.Range("AU2")
    Next
End Sub
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
4#
發表於 2021-7-23 16:29 | 只看該作者
回復 2# ziv976688


Sub test()
For Each ws In Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))
    Set Rng = ws.[AU2]
    Sheets("DATA").Range("A1850:I1875").Copy Rng
Next
End Sub

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
5#
發表於 2021-7-23 16:37 | 只看該作者
本帖最後由 ziv976688 於 2021-7-23 16:41 編輯

回復 3# ML089
謝謝您的指導~感恩

另外我把程式碼貼到DATA!
請問：下列的程式碼可以如何再簡(優)化?
謝謝您
TEST_連續複製.rar (84.14 KB)
    Nrange = "1878" 'InputBox("請輸入運算的迄止期數", "輸入期數")
    Num = "25" 'InputBox("請輸入複製的期距數範圍", "輸入距期數")

'連續複製
'列36
    For Each xS In Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))
        Sheets("DATA").Range("A" & Nrange - Num - 2, "I" & Nrange - 2).Copy xS.Range("AU2") '複製指定的DATA!A:I範圍貼上AU2
    Next
   
    For Each xS In Sheets(Array("準4進5", "準5進6", "準6進7", "準7進8"))
        Sheets("DATA").Range("A" & Nrange - Num - 3, "I" & Nrange - 3).Copy xS.Range("BD2")
    Next
   
    For Each xS In Sheets(Array("準5進6", "準6進7", "準7進8"))
        Sheets("DATA").Range("A" & Nrange - Num - 4, "I" & Nrange - 4).Copy xS.Range("BM2")
    Next

    For Each xS In Sheets(Array("準6進7", "準7進8"))
        Sheets("DATA").Range("A" & Nrange - Num - 5, "I" & Nrange - 5).Copy xS.Range("BV2")
    Next
        
    For Each xS In Sheets("準7進8")
        Sheets("DATA").Range("A" & Nrange - Num - 6, "I" & Nrange - 6).Copy xS.Range("CE2")
    Next

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
6#
發表於 2021-7-23 16:50 | 只看該作者
回復 4# samwang
謝謝您的指導~感恩
5樓的需求~懇請賜教。
謝謝您

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
7#
發表於 2021-7-23 22:56 | 只看該作者
本帖最後由 ML089 於 2021-7-23 23:07 編輯

回復 5# ziv976688

Nrange = "1878" 'InputBox("請輸入運算的迄止期數", "輸入期數")
    Num = "25" 'InputBox("請輸入複製的期距數範圍", "輸入距期數")

'    '連續複製
'    '列36
'    For Each xS In Sheets(Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))
'        Sheets("DATA").Range("A" & Nrange - Num - 2, "I" & Nrange - 2).Copy xS.Range("AU2")    '複製指定的DATA!A:I範圍貼上AU2
'    Next
'
'    For Each xS In Sheets(Array("準4進5", "準5進6", "準6進7", "準7進8"))
'        Sheets("DATA").Range("A" & Nrange - Num - 3, "I" & Nrange - 3).Copy xS.Range("BD2")
'    Next
'
'    For Each xS In Sheets(Array("準5進6", "準6進7", "準7進8"))
'        Sheets("DATA").Range("A" & Nrange - Num - 4, "I" & Nrange - 4).Copy xS.Range("BM2")
'    Next
'
'    For Each xS In Sheets(Array("準6進7", "準7進8"))
'        Sheets("DATA").Range("A" & Nrange - Num - 5, "I" & Nrange - 5).Copy xS.Range("BV2")
'    Next
'
'    For Each xS In Sheets("準7進8")
'        Sheets("DATA").Range("A" & Nrange - Num - 6, "I" & Nrange - 6).Copy xS.Range("CE2")
'    Next
   
   
    Srr = Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8")
    Prr = Array("AU2", "BD2", "BM2", "BV2", "CE2")
    Nrr = Array(2, 3, 4, 5, 6)
    For i = 0 To 4
       For j = i To 4 '注意 已經修改過
            Sheets("DATA").Range("A" & Nrange - Num - Nrr(i), "I" & Nrange - 6).Copy Sheets(Srr(j)).Range(Prr(i))
            Application.Goto Sheets(Srr(j)).Range(Prr(i))
        Next
    Next
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
8#
發表於 2021-7-23 22:58 | 只看該作者
Application.Goto Sheets(Srr(j)).Range(Prr(i))
這是測試用可以刪除
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
9#
發表於 2021-7-23 23:08 | 只看該作者
Srr = Array("準3進4", "準4進5", "準5進6", "準6進7", "準7進8")
    Prr = Array("AU2", "BD2", "BM2", "BV2", "CE2")
    Nrr = Array(2, 3, 4, 5, 6)
    For i = 0 To 4
       For j = i To 4 '注意 已經修改過
            Sheets("DATA").Range("A" & Nrange - Num - Nrr(i), "I" & Nrange - 6).Copy Sheets(Srr(j)).Range(Prr(i))
            Application.Goto Sheets(Srr(j)).Range(Prr(i))
        Next
    Next
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
10#
發表於 2021-7-23 23:27 | 只看該作者
回復 9# ML089
版主 :您好!
複製範圍有誤差~ TEST_連續複製(測試).rar (85.57 KB)
謝謝您

TOP

        靜思自在 : 天上最美是星星，人生最美是溫情。
12
返回列表 上一主題