Board logo

標題: [發問] VBA多活頁一次刪除空白列 [打印本頁]
作者: msmplay    時間: 2017-3-20 23:22     標題: VBA多活頁一次刪除空白列

[attach]26831[/attach]
以下巨集是網路上邊查資料邊改的，動作如下:
1. 全選"11&52", "12", "13", "14", "15", "21&26", "22", "24", "25", "32", "34", "41", "42", "43", "44", "47", "61", "62", "64", "71", "81", "82", "83", "84", "85", "91", "92", "M2"以上活頁
2. 選擇Rows("5:50")複製貼上為值（原本"5:50"是公式）
3. 如果Rows("5:50")A欄為空白，則由50至5逐一刪除空白列

希望網大可以協助修改一下達到以下需求：
1. 目前是一個活頁一個活頁動作，希望可以達到28個活頁一次動作，減少等待逐一活頁動作的時間
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub 整理訂單()
Application.Calculation = xlCalculationManual '關閉自動重算, 加快速度
    Sheets(Array("11&52", "12", "13", "14", "15", "21&26", "22", "24", "25", "32", "34", "41", "42", "43", "44", "47", "61", "62", "64", "71", "81", "82", "83", "84", "85", "91", "92", "M2")).Select
    Rows("5:50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

arr = Array("11&52", "12", "13", "14", "15", "21&26", "22", "24", "25", "32", "34", "41", "42", "43", "44", "47", "61", "62", "64", "71", "81", "82", "83", "84", "85", "91", "92", "M2")
For y = 0 To 27
Sheets(arr(y)).Select
  For i = 50 To 5 Step -1
      If Cells(i, "A") = "" Then
          Rows(i).Delete
      End If
  Next
Next
Application.Calculation = xlCalculationAutomatic '恢復自動重算
End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
[attach]26832[/attach]
作者: naruto018    時間: 2017-3-23 18:47

回復 1# msmplay

不敬責的簡單改良
  1. Sub 整理訂單()
  2. Application.Calculation = xlCalculationManual '關閉自動重算, 加快速度
  3. Selection.Copy
  4.   arr = Array("11&52", "12", "13", "14", "15", "21&26", "22", "24", "25", "32", "34", "41", "42", "43", "44", "47", "61", "62", "64", "71", "81", "82", "83", "84", "85", "91", "92", "M2")
  5. For y = 0 To 27
  6.     Sheets(arr(y)).Range("A5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  7. Next

  9. For y = 0 To 27
  10. Sheets(arr(y)).Select
  11.   For i = 50 To 5 Step -1
  12.       If Cells(i, "A") = "" Then
  13.           Rows(i).Delete
  14.       End If
  15.   Next
  16. Next
  17. Application.Calculation = xlCalculationAutomatic '恢復自動重算
  18. End Sub
複製代碼
作者: msmplay    時間: 2017-3-23 22:51

回復 2# naruto018


   n大~~~~雖然最後的刪除空白列動作還是每個活頁逐一執行，但整體感覺好像有快一點ㄝ，非常感謝你喔~~~~~~~~
作者: ML089    時間: 2017-3-24 00:08

回復 1# msmplay

執行前加入下列指令螢幕不顯示執行狀況
Application.ScreenUpdating = False

原先程式碼

Application.ScreenUpdating = True
作者: naruto018    時間: 2017-3-24 08:40

回復 3# msmplay


    想要加快程式運行的話，有很多方式
例如：去除程式中可省略的部分
或是像ML089大那樣添加減少運行時動作的程式碼
或是以相同功能但更高效能方式去執行的程式碼
作者: msmplay    時間: 2017-3-24 09:13

回復 4# ML089

M大~~~~~非常感謝！！！
作者: msmplay    時間: 2017-3-24 09:16

回復 5# naruto018


   n大~~~其實其實丫！因為我不是很懂程式，但又因為工作需求希望能加快作業效率~~~才會自己上網找方法跟自己測試看看！如果n大能幫忙修改跟優化此程式碼，那就真的是感激不盡了~~~~~~~
作者: 准提部林    時間: 2017-3-24 19:50

arr = Array(∼∼工作表名∼∼)
On Error Resume Next
For Each sh In arr
　　Sheets(sh).Range("A5:A50").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next
On Error GoTo 0
作者: msmplay    時間: 2017-3-25 13:15

回復 8# 准提部林


   准大~~謝謝你喔~~~~~~~~~~



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