求解：删除选定区域内的所有的空行空列（速度要快）

hunpo · 发表于 2011-11-28 16:51

本帖最后由 hunpo 于 2011-11-28 16:57 编辑

求VBA实现删除选定区域内的所有的空行空列（速度要快），数据量还是蛮大的，我的程序是这样的，效率很低，第一行或第一列是空时，也删除不掉，求更快速度的方法，或指正代码的错误：
Sub 删除空行空列()
Dim arr
Dim str As String
Set arr = ActiveSheet.UsedRange
Lastrow = ActiveSheet.UsedRange.rows.Count
LastColumn = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
For i = Lastrow To 1 Step -1
If Application.CountA(arr.rows(i)) = 0 Then
arr.rows(i).Delete
End If
Next i
Set arr = ActiveSheet.UsedRange
For j = LastColumn To 1 Step -1
   If Application.CountA(arr.Columns(j)) = 0 Then
      arr.Columns(j).Delete
   End If
Next j
Application.ScreenUpdating = True
End Sub

tianti · 发表于 2011-11-28 17:32

工作表中有多余的空行，还有多余的空列吗？

tianti · 发表于 2011-11-28 17:34

建议用定位条件空值来删除空行空列，可以录制个宏，查看下代码，然后加入循环就OK

Dj_soo · 发表于 2011-11-29 09:19

简单改了一下:

Sub 删除空行空列()
Dim Area_ As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim Ro As Long
Dim Col As Integer
Dim lstRo As Long
Dim lstCol As Integer
Set Area_ = ActiveSheet.UsedRange
lstRo = Area_.Rows.Count
lstCol = Area_.Columns.Count
Application.ScreenUpdating = False
For Ro = 1 To lstRo
If Application.CountA(Area_.Rows(Ro)) = 0 Then
If Rng1 Is Nothing Then
Set Rng1 = Cells(Ro, 1)
Else
Set Rng1 = Union(Rng1, Cells(Ro, 1))
End If
End If
Next
For Col = 1 To lstCol
If Application.CountA(Area_.Columns(Col)) = 0 Then
If Rng2 Is Nothing Then
Set Rng2 = Cells(1, Col)
Else
Set Rng2 = Union(Rng2, Cells(1, Col))
End If
End If
Next
Rng1.EntireRow.Delete
Rng2.EntireColumn.Delete
Set Area_ = Nothing
Set Rng1 = Nothing
Set Rng2 = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

Dj_soo · 发表于 2011-11-29 09:25

以上代码的缺点是如果首行首列空行空列无法删除,可以手动删

Dj_soo · 发表于 2011-11-29 09:58

本帖最后由 Dj_soo 于 2011-11-29 10:07 编辑

用这个吧

Option Explicit
Sub 删除空行空列()
Dim Area_ As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim Ro As Long
Dim Col As Integer
Dim lstRo As Long
Dim lstCol As Integer
If [A1] = "" Then
[A1] = 1
Set Area_ = ActiveSheet.UsedRange
[A1].ClearContents
Else
Set Area_ = ActiveSheet.UsedRange
End If
lstRo = Area_.Rows.Count
lstCol = Area_.Columns.Count
Application.ScreenUpdating = False
For Ro = 1 To lstRo
If Application.CountA(Area_.Rows(Ro)) = 0 Then
If Rng1 Is Nothing Then
Set Rng1 = Rows(Ro)
Else
Set Rng1 = Union(Rng1, Rows(Ro))
End If
End If
Next
For Col = 1 To lstCol
If Application.CountA(Area_.Columns(Col)) = 0 Then
If Rng2 Is Nothing Then
Set Rng2 = Columns(Col)
Else
Set Rng2 = Union(Rng2, Columns(Col))
End If
End If
Next
Rng1.EntireRow.Delete
Rng2.EntireColumn.Delete
Set Area_ = Nothing
Set Rng1 = Nothing
Set Rng2 = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

hunpo · 发表于 2011-11-29 10:32

Dj_iso兄,不错,是实现了,但是运行起来,感觉还是比较慢,因为我的数据有几万行,有没有不是循环的方法,解决此问题,期望能有更快更高效的方法呵

Dj_soo · 发表于 2011-11-29 11:49

hunpo 发表于 2011-11-29 10:32
Dj_iso兄,不错,是实现了,但是运行起来,感觉还是比较慢,因为我的数据有几万行,有没有不是循环的方法,解决此问 ...

没有不用循环的办法.
如果用数组可能会快些,但是写代码太麻烦了

hunpo · 发表于 2011-11-29 14:15

写数组，DJ_ISO兄，写数组能实现吗？能说说你用数组的方式怎么去实现啊，不用写代码，只说说你的设计思路

fjmxwrs · 发表于 2011-11-30 00:34

本帖最后由 fjmxwrs 于 2011-11-30 00:36 编辑

这个速度应该还可以吧

Sub 删除空行空列()
Dim arr, i&, j&
arr = UsedRange
Application.ScreenUpdating = False
For i = UBound(arr) To 1 Step -1
If Application.CountA(Rows(i)) = 0 Then Rows(i).Delete
Next i
For j = UBound(arr, 2) To 1 Step -1
If Application.CountA(Columns(j)) = 0 Then Columns(j).Delete
Next j
Application.ScreenUpdating = True
End Sub

		自动登录	找回密码
密码			注册

求解：删除选定区域内的所有的空行空列（速度要快）

相关帖子