[發問] VBA刪除空白ROW COLUMN

missbb

按CTRL 下箭咀, 遊標去到AK170, 但其有資料的行/列只去到E150. 如何可用VBA快除除去151至170的空白ROW及F至AK的空白欄? 因會令檔案容量很大.

有勞各位, 因在網貢看予很多文章悖做不到.:'(

除去空白ROW.zip (19.06 KB)

下載次數: 15

2018-5-30 19:14

Kubi

回復 1# missbb
以下是土法煉鋼的結果：

1. Sub test()
   
2.     For n = 1 To 2
   
3.         er = 0
   
4.         ec = 0
   
5.         With ActiveSheet
   
6.             For j = 1 To .UsedRange.Columns.Count
   
7.                 For i = 1 To .UsedRange.Rows.Count
   
8.                     If .Cells(i, j).Value <> "" Then
   
9.                         If i > er Then er = i
   
10.                         If j > ec Then ec = j
    
11.                     End If
    
12.                 Next i
    
13.             Next j
    
14.             .Rows(er + 1 & ":" & Cells.Rows.Count).Delete
    
15.             .Range(Columns(ec + 1), Columns(Cells.Columns.Count)).Delete
    
16.         End With
    
17.     Next n
    
18. End Sub

複製代碼

別問我為何要迴圏兩次？這是多方測試結果(還是有前輩知道原因並告知)，若不用迴圈的話，則最後一列要加上程式碼來關閉檔案：
ActiveWorkbook.Close 1

關檔案的用意是經過再開啟本檔案的程序才會生效。

GBKEE

回復 1# missbb
是這樣嗎?
****最後有資料的列位,其實不是最後有使用過的列位***(UsedRange)

1. Option Explicit
   
2. Sub Ex()
   
3.     If Cells.SpecialCells(xlCellTypeLastCell).Row <> [E1].End(xlDown).Row Then
   
4.         Rows([E1].End(xlDown).Row + 1 & ":" & Cells.SpecialCells(xlCellTypeLastCell).Row).Delete
   
5.     End If
   
6. End Sub

複製代碼

Kubi

回復 3# GBKEE
樓主的用意是說按 {END} 鍵後再按 {HOME} 鍵，會將油標移至
Cells.SpecialCells(xlCellTypeLastCell).Select 位置，也就是AK170儲存格。

不僅僅該儲存格是空值之外，於AK170儲存格往左(F:AK欄)或往上(151:170列)的範圍內儲存格都是空值。

樓主是想說利用程式將虛擬的空儲存格去除，以後再按 {END} 鍵再按 {HOME} 鍵，游標會移至真正有資料的右下角儲存格E150，而不是AK170。
而且若不將這些空的儲存格清除或刪除，將會佔用記憶體也會讓檔案肥大。

會造成xlCellTypeLastCell誤判，可能原因是複製含有格式的資料(如Copy網頁內的資料)貼入工作表，
之後若該貼入的資料用不上時再用Delelet鍵刪除，就會產生如上面的誤判現象。

另外用Range的UsedRange屬性也會涵蓋A1:AK170範圍。

以上是個人觀察結果供參。

GBKEE

回復 4# Kubi
補上完整程式後
UsedRange會是在最後儲存格有資料的範圍內

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim R(1 To 2), C(1 To 2) As Long, Rng As Range
   
4.     Debug.Print  ActiveSheet.UsedRange.Address
   
5.     If Application.CountA(Cells) = 0 Then Exit Sub
   
6.     Set Rng = Cells.SpecialCells(xlCellTypeConstants)
   
7.     Set Rng = Rng.Areas(Rng.Areas.Count)
   
8.     Set Rng = Rng.Cells(Rng.Cells.Count)
   
9.     With Rng
   
10.         R(1) = .Row
    
11.         C(1) = .Column
    
12.     End With
    
13.     With Cells.SpecialCells(xlCellTypeLastCell)
    
14.         R(2) = .Row
    
15.         C(2) = .Column
    
16.     End With
    
17.     If R(1) <> R(2) Then Rows(R(1) + 1 & ":" & R(2)).Delete
    
18.     If C(1) <> C(2) And C(1) + 1 = C(2) Then Range(Columns(C(1) + 1), Columns(C(2))).Delete
    
19.     ActiveSheet.Parent.Save
    
20.     Debug.Print  ActiveSheet.UsedRange.Address
    
21. End Sub

複製代碼

Kubi

回復 5# GBKEE
執行GBKEE版主的最後一行 Debug.Print ActiveSheet.UsedRange.Address 後
顯示的是 $A$1:$AK$150

若能執行到最後一行 Debug.Print ActiveSheet.UsedRange.Address 後
顯示的是 $A$1:$E$150

可能就是樓主所要的結果

准提部林

Sub TEST()
Dim UR As Range, xF As Range
Set UR = Range([A1], ActiveSheet.UsedRange)
Set UR = UR(UR.Count)

Set xF = Cells.Find("*", UR(2), xlValues, xlPart, xlByRows, xlPrevious)
If UR.Row > xF.Row Then Set UR = UR(2): Range(xF(2), UR(0)).EntireRow.Delete

Set xF = Cells.Find("*", UR(1, 2), xlValues, xlPart, xlByColumns, xlPrevious)
If UR.Column > xF.Column Then Range(xF(1, 2), UR).EntireColumn.Delete
ActiveSheet.UsedRange
End Sub

Kubi

終於了解到原來 Delete 若沒有加上參數 Shift，VBA 會自動判斷刪除之後的儲存格位移方向，
所以若加上參數 Shift 後，就會與 EntireRow.Delete、EntireColumn.Delete 產生相同效果。

missbb

回復 8# Kubi

非常感謝:)