[已解决]VBA多活頁一次刪除空白列

msmplay

以下巨集是網路上邊查資料邊改的，動作如下:
1. 全選"11&52"......"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, 下载次数: 2)

2017-3-23 12:37 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

wenzili

2017-3-24 15:56

Public Sub dd()
Dim sht As Worksheet
For Each sht In Worksheets
sht.Range("a5:a50").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next

End Sub
怎么都得一个个工作簿做吧。
原程序可以优化，提高速度，见上。
原拷贝粘贴值是为了将有公式的行保留？
如是，上面代码可完美解决。显示为空单元但是有公式的也不会删除。

跳转到最佳答案楼层

wenzili

Public Sub dd()
Dim sht As Worksheet
For Each sht In Worksheets
sht.Range("a5:a50").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next

End Sub
怎么都得一个个工作簿做吧。
原程序可以优化，提高速度，见上。
原拷贝粘贴值是为了将有公式的行保留？
如是，上面代码可完美解决。显示为空单元但是有公式的也不会删除。