返回列表 上一主題 發帖

[發問] VBA多活頁一次刪除空白列

[發問] VBA多活頁一次刪除空白列

擷取.PNG
2017-3-20 23:03

以下巨集是網路上邊查資料邊改的,動作如下:
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

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
測試.rar (16.6 KB)
*宅女一枚無誤*

回復 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

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

TOP

回復 2# naruto018


   n大~~~~雖然最後的刪除空白列動作還是每個活頁逐一執行,但整體感覺好像有快一點ㄝ,非常感謝你喔~~~~~~~~
*宅女一枚無誤*

TOP

回復 1# msmplay

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

原先程式碼

Application.ScreenUpdating = True
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 3# msmplay


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

TOP

回復 4# ML089

M大~~~~~非常感謝!!!
*宅女一枚無誤*

TOP

回復 5# naruto018


   n大~~~其實其實丫!因為我不是很懂程式,但又因為工作需求希望能加快作業效率~~~才會自己上網找方法跟自己測試看看!如果n大能幫忙修改跟優化此程式碼,那就真的是感激不盡了~~~~~~~
*宅女一枚無誤*

TOP

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
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 8# 准提部林


   准大~~謝謝你喔~~~~~~~~~~
*宅女一枚無誤*

TOP

        靜思自在 : 話多不如話少,話少不如話好。
返回列表 上一主題