Board logo

標題: [發問] VBA刪除空白ROW COLUMN [打印本頁]
作者: missbb    時間: 2018-5-30 19:14     標題: VBA刪除空白ROW COLUMN

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

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

[attach]28782[/attach]
作者: Kubi    時間: 2018-5-31 15:26

回復 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    時間: 2018-6-1 06:18

回復 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    時間: 2018-6-1 21:48

回復 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    時間: 2018-6-2 15:36

本帖最後由 GBKEE 於 2018-6-2 17:57 編輯

回復 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    時間: 2018-6-2 21:20

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

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

可能就是樓主所要的結果
作者: 准提部林    時間: 2018-6-3 17:53

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    時間: 2018-6-4 11:30

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

回復 8# Kubi

非常感謝:)



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