[已解决]为什吗一次删除不了呀

zss427607

用新建excel 打开 新11文件， 然后判断新11的 C列中 左边第一个字符不等于 “退” 的数据全部删除。

但是不知道为什么 ， 一次性删除不了？

请各位帮忙看看

咋回事呀

谢谢了

最佳答案

月排行榜 / 总排行榜

爱疯

2011-10-2 11:56

回复 zss427607 的帖子

1. 
   
2. Private Sub CommandButton1_Click()
   
3.     Dim str, wk, A, B, i, s
   
4. 
   
5.     str = "新11.xls"
   
6.     On Error Resume Next
   
7.     Workbooks(str).Close
   
8.     On Error GoTo 0
   
9. 
   
10.     Set wk = Workbooks.Open(ThisWorkbook.Path & "" & str)
    
11.     With wk.Sheets("sheet1")
    
12.         A = .Range("a1:c" & .Range("a65536").End(xlUp).Row)
    
13.         ReDim B(1 To UBound(A), 1 To UBound(A, 2))
    
14.         For i = 1 To UBound(A)
    
15.             If Left(A(i, 3), 1) = "退" Then
    
16.                 s = s + 1
    
17.                 B(s, 1) = A(i, 1)
    
18.                 B(s, 2) = A(i, 2)
    
19.                 B(s, 3) = A(i, 3)
    
20.             End If
    
21.         Next i
    
22.         If s > 0 Then
    
23.             .Cells.Clear
    
24.             .Range("a1").Resize(s, UBound(B, 2)) = B
    
25.         End If
    
26.     End With
    
27.     Set wk = Nothing
    
28. 
    
29.     Application.DisplayAlerts = False
    
30.     Workbooks(str).Close True
    
31. End Sub

复制代码

这样的，可以吗{:041:}

跳转到最佳答案楼层

爱疯

回复 zss427607 的帖子

1. 
   
2. Private Sub CommandButton1_Click()
   
3.     Dim str, wk, A, B, i, s
   
4. 
   
5.     str = "新11.xls"
   
6.     On Error Resume Next
   
7.     Workbooks(str).Close
   
8.     On Error GoTo 0
   
9. 
   
10.     Set wk = Workbooks.Open(ThisWorkbook.Path & "" & str)
    
11.     With wk.Sheets("sheet1")
    
12.         A = .Range("a1:c" & .Range("a65536").End(xlUp).Row)
    
13.         ReDim B(1 To UBound(A), 1 To UBound(A, 2))
    
14.         For i = 1 To UBound(A)
    
15.             If Left(A(i, 3), 1) = "退" Then
    
16.                 s = s + 1
    
17.                 B(s, 1) = A(i, 1)
    
18.                 B(s, 2) = A(i, 2)
    
19.                 B(s, 3) = A(i, 3)
    
20.             End If
    
21.         Next i
    
22.         If s > 0 Then
    
23.             .Cells.Clear
    
24.             .Range("a1").Resize(s, UBound(B, 2)) = B
    
25.         End If
    
26.     End With
    
27.     Set wk = Nothing
    
28. 
    
29.     Application.DisplayAlerts = False
    
30.     Workbooks(str).Close True
    
31. End Sub

复制代码

这样的，可以吗{:041:}

zss427607

爱版  x

谢谢了

可以，用循环为啥不行呀？

zyjs029

不知楼主的意思是这样的么  （不过这样的问题在excel里就直接可以操作了 不需要vba的）
Sub a()
Dim x As Integer
For x = 2 To 10000
  If Left(Cells(x, 3), 1) <> "退" Then
   Cells(x, 3).ClearContents
  End If
Next x
End Sub

zss427607

zyjs029 发表于 2011-10-2 16:38
不知楼主的意思是这样的么  （不过这样的问题在excel里就直接可以操作了 不需要vba的）
Sub a()
Dim x As ...

我是用得循环判断 删除的

但是不知为什么， 运行一次后 还是有数据 未删除 ？

zyjs029

那你上传你的附件+代码瞅瞅 是不是没循环完还是怎么回事

zss427607

zyjs029 发表于 2011-10-2 16:56
那你上传你的附件+代码瞅瞅 是不是没循环完还是怎么回事

老大  附件 及 代码

在一楼呀

爱疯

1. 
   
2. Private Sub CommandButton1_Click()
   
3. 
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.     Set ws = Workbooks.Open(ThisWorkbook.Path & "" & "新11.xls")
   
7.     Debug.Print Sheets(Sheets.Count).Name    '返回Sheet3
   
8.     Debug.Print Sheets(Sheets.Count).[a65536].End(xlUp).Row    '返回1
   
9. 
   
10. '    For i = 2 To ws.Sheets(Sheets.Count).[a65536].End(xlUp).Row
    
11. '        If ws.Sheets(Sheets.Count).Cells(i, 3) <> "" And _
    
12. '           Left(ws.Sheets(Sheets.Count).Cells(i, 3), 1) <> "退" Then
    
13. '            ws.Sheets(Sheets.Count).Activate
    
14. '            ws.Sheets(Sheets.Count).Cells(i, 3).Select
    
15. '            Selection.EntireRow.Delete
    
16. '        End If
    
17. '    Next i
    
18. 
    
19.     '实际相当于
    
20.     For i = 2 To 1
    
21.     Next i
    
22.     '循环刚要开始，就结束了，因为i的值已经是2了，超过1了，即不执行循环。
    
23.     ActiveWorkbook.Save
    
24.     ActiveWorkbook.Close
    
25.     Sheets("Sheet1").Activate
    
26.     Sheets("Sheet1").Range("A1").Select
    
27. End Sub

复制代码

{:041:}