[已解决]代码测试

642070295

循环体中的2条删除代码没有执行出结果（也没有任何出错提示），而是直接运行了next后面的语句了。咋回事呢？
麻烦老师帮测试一下并纠正代码（代码在模块1里）。先谢了！ 测试-附件.rar (58.57 KB, 下载次数: 73)

2013-11-25 10:50 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

美斯特邦威

2013-11-25 11:06

1. Sub TEST()
   
2.     Application.ScreenUpdating = False
   
3.     Dim m&, j&
   
4. s:        For m = Sheets("rK").Range("b1048576").End(xlUp).Row To 399 Step -1
   
5.             If Sheets("rK").Range("b" & m) = 0 Then
   
6.                 For j = 1 To Sheets("Slj").[xfd1].End(xlToLeft).Column Step 2
   
7.                     If Trim(Sheets("Slj").Cells(1, j)) = Sheets("rK").Cells(m, "a") Then
   
8.                         Union(Sheets("Slj").Columns(j), Sheets("Slj").Columns(j + 1)).Delete shift:=xlToLeft
   
9.                         Sheets("rK").Rows(m).Delete shift:=xlUp
   
10.                     End If
    
11.                 Next j
    
12.             End If
    
13.         Next m
    
14.         Sheets("Sl").Range("a1:b" & Sheets("Sl").Range("b1048576").End(xlUp).Row).Copy
    
15.         Sheets("Slj").Range("a5").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    
16.      ' Sheets("Slj").Range("xfd5").End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    
17.    Application.ScreenUpdating = True
    
18. End Sub
    
19. 
    

复制代码

跳转到最佳答案楼层

美斯特邦威

1. Sub TEST()
   
2.     Application.ScreenUpdating = False
   
3.     Dim m&, j&
   
4. s:        For m = Sheets("rK").Range("b1048576").End(xlUp).Row To 399 Step -1
   
5.             If Sheets("rK").Range("b" & m) = 0 Then
   
6.                 For j = 1 To Sheets("Slj").[xfd1].End(xlToLeft).Column Step 2
   
7.                     If Trim(Sheets("Slj").Cells(1, j)) = Sheets("rK").Cells(m, "a") Then
   
8.                         Union(Sheets("Slj").Columns(j), Sheets("Slj").Columns(j + 1)).Delete shift:=xlToLeft
   
9.                         Sheets("rK").Rows(m).Delete shift:=xlUp
   
10.                     End If
    
11.                 Next j
    
12.             End If
    
13.         Next m
    
14.         Sheets("Sl").Range("a1:b" & Sheets("Sl").Range("b1048576").End(xlUp).Row).Copy
    
15.         Sheets("Slj").Range("a5").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    
16.      ' Sheets("Slj").Range("xfd5").End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    
17.    Application.ScreenUpdating = True
    
18. End Sub
    
19. 
    

复制代码

642070295

美斯特邦威 发表于 2013-11-25 11:06

请问老师，原代码错处在哪个地方？能标出颜色看清楚点吗？最好注解一下！麻烦老师指点！

642070295

642070295 发表于 2013-11-25 11:14
请问老师，原代码错处在哪个地方？能标出颜色看清楚点吗？最好注解一下！麻烦老师指点！

问题已解决！谢谢老师！

美斯特邦威

642070295 发表于 2013-11-25 11:14
请问老师，原代码错处在哪个地方？能标出颜色看清楚点吗？最好注解一下！麻烦老师指点！

第七行，加了个trim去空格而已，其他没动

642070295

美斯特邦威 发表于 2013-11-25 14:17
第七行，加了个trim去空格而已，其他没动

好的，知道了，谢谢老师！