Board logo

標題: 請簡化錄製的程式碼 [打印本頁]
作者: ziv976688    時間: 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    時間: 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
作者: ML089    時間: 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
作者: samwang    時間: 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
作者: ziv976688    時間: 2021-7-23 16:37

本帖最後由 ziv976688 於 2021-7-23 16:41 編輯

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

另外我把程式碼貼到DATA!
請問：下列的程式碼可以如何再簡(優)化?
謝謝您
[attach]33729[/attach]
    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
作者: ziv976688    時間: 2021-7-23 16:50

回復 4# samwang
謝謝您的指導~感恩
5樓的需求~懇請賜教。
謝謝您
作者: ML089    時間: 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
作者: ML089    時間: 2021-7-23 22:58

Application.Goto Sheets(Srr(j)).Range(Prr(i))
這是測試用可以刪除
作者: ML089    時間: 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
作者: ziv976688    時間: 2021-7-23 23:27

回復 9# ML089
版主 :您好!
複製範圍有誤差~[attach]33734[/attach]
謝謝您
作者: ziv976688    時間: 2021-7-23 23:43

回復 9# ML089
OK了
Sheets("DATA").Range("A" & Nrange - Num - Nrr(i), "I" & Nrange - 6).Copy Sheets(Srr(j)).Range(Prr(i))
改
Nrange - Nrr(i)
程式碼精簡很多，也學到許多語法。
謝謝您的耐心指導和幫忙~感恩
作者: ziv976688    時間: 2021-7-24 01:33

回復 9# ML089
版主 :
下列提問，懇請您指導 ~
http://forum.twbts.com/thread-23273-1-1.html
謝謝您 ! 晚安



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)