请问清除内容后如何让下方的单元格自动上移

yiminglian

1. Private Sub CommandButton8_Click()
   
2. T = Timer
   
3. Dim i As Integer
   
4. i = ActiveCell.Row
   
5. Cells(i, 1) = ""
   
6. Cells(i, 2) = ""
   
7. Cells(i, 3) = ""
   
8. Cells(i, 4) = ""
   
9. Cells(i, 5) = ""
   
10. Cells(i, 6) = ""
    
11. Cells(i, 7) = ""
    
12. Cells(i, 8) = ""
    
13. Cells(i, 9) = ""
    
14. Cells(i, 10) = ""
    
15. Cells(i, 11) = ""
    
16. Cells(i, 12) = ""
    
17. Cells(i, 13) = ""
    
18. Cells(i, 14) = ""
    
19. Cells(i, 15) = ""
    
20. Do While Cells(i + 1, 1) <> ""
    
21.     Cells(i, 1) = Cells(i + 1, 1)
    
22.     Cells(i, 2) = Cells(i + 1, 2)
    
23.     Cells(i, 3) = Cells(i + 1, 3)
    
24.     Cells(i, 4) = Cells(i + 1, 4)
    
25.      Cells(i, 5) = Cells(i + 1, 5)
    
26.       Cells(i, 6) = Cells(i + 1, 6)
    
27.        Cells(i, 7) = Cells(i + 1, 7)
    
28.         Cells(i, 8) = Cells(i + 1, 8)
    
29.          Cells(i, 9) = Cells(i + 1, 9)
    
30.           Cells(i, 10) = Cells(i + 1, 10)
    
31.            Cells(i, 11) = Cells(i + 1, 11)
    
32.             Cells(i, 12) = Cells(i + 1, 12)
    
33.              Cells(i, 13) = Cells(i + 1, 13)
    
34.               Cells(i, 14) = Cells(i + 1, 14)
    
35.                Cells(i, 15) = Cells(i + 1, 15)
    
36.     i = i + 1
    
37. Loop
    
38. Cells(i, 1) = ""
    
39. Cells(i, 2) = ""
    
40. Cells(i, 3) = ""
    
41. Cells(i, 4) = ""
    
42. Cells(i, 5) = ""
    
43. Cells(i, 6) = ""
    
44. Cells(i, 7) = ""
    
45. Cells(i, 8) = ""
    
46. Cells(i, 9) = ""
    
47. Cells(i, 10) = ""
    
48. Cells(i, 11) = ""
    
49. Cells(i, 12) = ""
    
50. Cells(i, 13) = ""
    
51. Cells(i, 14) = ""
    
52. Cells(i, 15) = ""
    
53. MsgBox "共计用时" & "   " & (Timer - T) & "秒", , "温馨提示"
    
54. 
    
55. 
    
56. End Sub

复制代码

以上代码虽然可以实现但运算速度不行。论坛老师让我使用数组但小弟刚接触数组这块薄弱请求支援
想要实现的效果是选中一行或选中某行某一单元格清除该行的内容，因为我做了保护所以不能使用删除！求大神改写代码或提供新的思路~~
Book1.rar (7.21 KB, 下载次数: 14)

2015-4-18 09:27 上传

点击文件名下载附件

dsmch

1. Sub Macro1()
   
2.     ActiveSheet.Unprotect
   
3.     Selection.EntireRow.Delete
   
4. End Sub
   

复制代码

yiminglian

dsmch 发表于 2015-4-18 09:42

这个我知道但是我保护工作簿了是不能运行带有delete的命令的

wj2368

。。。。。。。。。。。。。。。

yiminglian

wj2368 发表于 2015-4-18 09:48
。。。。。。。。。。。。。。。

我没说清楚其实我保护的目的是因为在400行有公式统计，如果我删除了该行那么公式行就会上移这样我就没法正常统计了

yiminglian

dsmch 发表于 2015-4-18 09:42

400行有公式统计，如果我删除了该行那么公式行就会上移这样我就没法正常统计了

Vicel

yiminglian 发表于 2015-4-18 10:03
400行有公式统计，如果我删除了该行那么公式行就会上移这样我就没法正常统计了

楼主最好是能够上个完整的附件

楼主担心的公式问题可由代码在删除行数据后再重写

yiminglian

Vicel 发表于 2015-4-18 12:20
楼主最好是能够上个完整的附件

楼主担心的公式问题可由代码在删除行数据后再重写

Book1.rar (15.05 KB, 下载次数: 10)

2015-4-18 13:07 上传

点击文件名下载附件

附件更新了

Vicel

yiminglian 发表于 2015-4-18 13:07
附件更新了

其实不管公式那也行的，也不用管工作表是不是在保护状态下。本代码只对允许录入数据区域作修改，选择区域在单行内。当然，如果想选择连续多行的话，也是可以的，那样就还得调整下代码。

1. Sub test()
   
2.     Dim rng As Range, n&, ar
   
3.     Set rng = Selection
   
4.     n = rng.Row
   
5.     If rng.Rows.Count > 1 Or n = 1 Or n > 400 Then
   
6.         MsgBox "请选择第2至400行区间的某一单元格或行"
   
7.     Else
   
8.         Set rng = Range("A" & n & ":D" & n)
   
9.         rng.ClearContents
   
10.         If n <> 400 Then
    
11.             ar = rng.Offset(1, 0).Resize(400 - n)
    
12.             rng.Resize(400 - n) = ar
    
13.             [A400:D400].ClearContents
    
14.         End If
    
15.     End If
    
16.     Set rng = Nothing
    
17. End Sub
    

复制代码

test.rar (15.81 KB, 下载次数: 44)

2015-4-18 13:58 上传

点击文件名下载附件

yiminglian

Vicel 发表于 2015-4-18 13:58
其实不管公式那也行的，也不用管工作表是不是在保护状态下。本代码只对允许录入数据区域作修改，选择区域 ...

哇哦相当感谢