[已解决]执行VBA代码提示，错误13

yjwdjfqb

执行VBA代码提示，错误13

删除完全相同行－－（执行第一次代码有问题，执行第二次也有问题）.rar (5.53 KB, 下载次数: 7)

2014-3-19 19:26 上传

点击文件名下载附件
删除整行空白行－－问题（执行第一次代码有问题，执行第二次也有问题）.rar (4.89 KB, 下载次数: 10)

2014-3-19 19:26 上传

点击文件名下载附件

请大家帮我看看是什么问题，帮帮修正下好不老师们　！

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-19 22:04

两个代码类似，你自己修改一下，附件测试没有发现问题

跳转到最佳答案楼层

dsmch

代码是针对附件写的，刻舟求剑的事不要做。
用ActiveSheet.UsedRange.Select 试试各个附件中的数据区域有什么不同

yjwdjfqb

dsmch 发表于 2014-3-19 20:11
代码是针对附件写的，刻舟求剑的事不要做。
用ActiveSheet.UsedRange.Select 试试各个附件中的数据区域有什 ...

老师你好，这二个都是你帮我写的，可以把这二个修改下，让这二个代码能有通用性吗，谢谢啦！

dsmch

1. Sub 删除整行空白行()
   
2.     Dim arr, rng As Range, c As Range, i&, x%
   
3.     Set c = ActiveSheet.UsedRange
   
4.     If IsEmpty(ActiveSheet.UsedRange) Then MsgBox "当前工作表中没有数据！", vbInformation + vbOKOnly, "提示": Exit Sub
   
5.     arr = Cells(1, c(1).Column).Resize(c(1).Row + c.Rows.Count - 1, c.Columns.Count)
   
6.     x = UBound(arr, 2)
   
7.     Application.ScreenUpdating = False
   
8.     For i = 1 To UBound(arr)
   
9.         If Application.CountA(Cells(i, 1).Resize(1, x)) = 0 Then
   
10.             If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
11.         End If
    
12.     Next
    
13.     If Not rng Is Nothing Then rng.EntireRow.Delete
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    

复制代码

yjwdjfqb

dsmch 发表于 2014-3-19 21:25

感谢老师的修改，但用附件测试时，会删除有数据的行

dsmch

两个代码类似，你自己修改一下，附件测试没有发现问题