誰能幫這幾乎重複動作的VBA瘦身謝謝 - Excel程式區

帖子: 10
主題: 2
精華: 0
積分: 60
點名: 0
作業系統: win7
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2015-6-3
最後登錄: 2017-1-13

2^#

發表於 2015-8-25 17:06 | 顯示全部帖子

透過起行及迄行執行，可超過萬筆copy：
Sub test()
Rem '起行=3，迄行=10000，執行時間：16:13:30~16:47:10
Application.ScreenUpdating = False
lineBegin = Worksheets("Data").Range("I4") '起行
lineEnd = Worksheets("Data").Range("J4") '迄行
For i = 1 To 10
      Worksheets("析" & i).Activate
      Rows(2).Copy
      For j = lineBegin To lineEnd
         Rows(j).PasteSpecial Paste:=xlPasteValues
      Next
      Rem 取消複製模式
      Application.CutCopyMode = False
Next
Application.ScreenUpdating = True
End Sub

[color=blue]KY[/color]

帖子: 10
主題: 2
精華: 0
積分: 60
點名: 0
作業系統: win7
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2015-6-3
最後登錄: 2017-1-13

3^#

發表於 2015-8-27 14:56 | 顯示全部帖子

我想你現在需要的，並不只是單純的程式開發，而是如何使用有限的系統資源建置大量的資料。
這是滿高階的問題解決技巧，無法細說，只能提供實例。
將錄製的巨集瘦身，它使用的系統資源還是很高，
目前在我的環境下，產生1000筆左右之資料，使用資源及執行效能尚可，
若是要產生3200筆的資料，耗用約20分30秒之後，會出現訊息：【記憶體不足】。
用我的程式，我是以1000筆為處理單位，耗用約07分產生64000筆資料，正常結束。
提醒：xls一個工作表最多只能有65536筆資料。
請在《Data》工作表之I4及J4儲存格輸入起始列及終止列。

Sub copyForNext()
Rem buffer = 999：每1000筆為1個處理單位
Application.ScreenUpdating = False
Call clearRow '清除舊資料
buffer = 999
lineBegin = Worksheets("Data").Range("I4") '起行
lineEnd = Worksheets("Data").Range("J4") '迄行
For i = 1 To 10
      Worksheets("析" & i).Activate
      Rows(2).Copy
      For j = lineBegin To lineEnd
         k = j + buffer
         Rows(j & ":" & k).Select
         Selection.PasteSpecial Paste:=xlPasteAll
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues
         j = k
      Next
      Rem 取消複製模式
      Application.CutCopyMode = False
Next
Application.ScreenUpdating = True
End Sub

Sub clearRow()
Worksheets(Array("析1", "析2", "析3", "析4", "析5", "析6", "析7", "析8", "析9", "析10")).Select
Rows("3:" & Rows.Count).Select
Selection.Clear
'以下動作，只是清除先前的選擇，以免人工要去取消選擇。
Range("A1").Select '目的：先前選擇區域的反影，只留選擇"A1"之儲存格
Worksheets("析1").Select '目的：先前選擇十個工作表，只留一個選擇"析1"之工作表
End Sub

[color=blue]KY[/color]

帖子: 10
主題: 2
精華: 0
積分: 60
點名: 0
作業系統: win7
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2015-6-3
最後登錄: 2017-1-13

4^#

發表於 2015-8-27 17:35 | 顯示全部帖子

回復 11# lcctno
請確認輸入的值和資料型態是否為數字

[color=blue]KY[/color]

帖子: 10
主題: 2
精華: 0
積分: 60
點名: 0
作業系統: win7
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2015-6-3
最後登錄: 2017-1-13

5^#

發表於 2015-8-27 17:40 | 顯示全部帖子

回復 13# lcctno
我也正好要瞭解我的系統資源之極限，以便程式之開發，你的程式正好可以協助我進行，謝謝。

[color=blue]KY[/color]

帖子: 10
主題: 2
精華: 0
積分: 60
點名: 0
作業系統: win7
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2015-6-3
最後登錄: 2017-1-13

6^#

發表於 2015-8-28 09:52 | 顯示全部帖子

回復 17# lcctno

先處理第一個問題：
'Call clearRow '清除舊資料看能不能只清除當下要執行的地方否則之前之值就被清除了變成必須要從頭執行那就無法結省處理時間(因為每週增加於工作頁"Data"之列數只有少數幾列)
請問：你所謂的當下是什麼？你上次提到要自第3行起清除資料，我只是call它，以免新舊資料不分。

[color=blue]KY[/color]

帖子: 10
主題: 2
精華: 0
積分: 60
點名: 0
作業系統: win7
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2015-6-3
最後登錄: 2017-1-13

7^#

發表於 2015-8-28 10:21 | 顯示全部帖子

我研判你需要的應是：
Sub clearRow()
Worksheets(Array("析1", "析2", "析3", "析4", "析5", "析6", "析7", "析8", "析9", "析10")).Select
lineBegin = Worksheets("Data").Range("K4") '起行
Rows(lineBegin & ":" & Rows.Count).Select '自你指定的起行清到最後
Selection.Clear
Range("A1").Select
Worksheets("析1").Select
End Sub

[color=blue]KY[/color]