怎样才能让宏自动帮我查找清空区域？

合肥狮子

怎样才能让宏自动帮我查找清空区域？

Sub 事中选定区域清空()
Dim Myarr As Range
On Error Resume Next
ConF1 = MsgBox("是否已备份？确认清空内容？", vbYesNo)
   Set Myarry = Application.InputBox("请选择清空范围", "选择", Type:=8)
If ConF1 = vbYes Then
   ConF2 = InputBox("请输入确认密码", "密码输入框")
   If ConF2 = "123" Then
   If Err <> 0 Then MsgBox "没有选择区域", 64, "温馨提示": Exit Sub
      Myarry.ClearContents
   End If
End If
End Sub
————————————————
每次都要手工选择很烦，我想改成Sub 自动选定通讯录区域清空()，请您帮忙！
1、在给定的区域内查找“通讯录”所在列，
2、查找通讯录所在列上一个通讯录下两行开始、下一个通讯录上一行结束，
3、把内容清空；
就是让宏自动帮我查找清空区域，免去我每次查找的麻烦！
感谢yangyangzhifeng 的无私支持！谢谢！{:soso_e183:}
已经做好的附件：
★Excel 201212答疑解惑.rar (71.52 KB, 下载次数: 13)

2013-1-5 10:12 上传

点击文件名下载附件

yangyangzhifeng

你的工作表有太多函数，现改为数组及禁事件和改为手动重算，速度应该可以了

1. Sub 事中选定区域清空()
   
2.     Dim Myarr As Range, i&, conf1, conf2, ar, rng As Range, st$, c&, r&, rr As Range, brr, rw, cc
   
3.     On Error Resume Next
   
4.     conf1 = MsgBox("是否已备份 确认清空内容 ", vbYesNo)
   
5.     Set Myarr = Application.InputBox("请选择清空范围", "选择", Type:=8)
   
6.     If Err <> 0 Then MsgBox "没有选择区域", 64, "温馨提示": Exit Sub
   
7.     conf2 = InputBox("请输入确认密码", "密码输入框")
   
8.     If conf2 <> "123" Then MsgBox "密码错误！": Exit Sub
   
9.     ar = Split(Myarr.Address, "$")
   
10.     Set rng = Myarr.Find("通讯录", lookat:=xlWhole, searchorder:=xlByRows)
    
11.     st = rng.Address: r = rng.Row
    
12.     Application.ScreenUpdating = False
    
13.     brr = Myarr: rw = Myarr.Row: cc = Myarr.Column
    
14.     Application.EnableEvents = False
    
15.     Application.Calculation = xlCalculationManual
    
16.     Do
    
17.         c = rng.Column
    
18.         For i = r To Val(ar(UBound(ar)))
    
19.             If brr(i - rw + 1, c - cc + 1) <> "通讯录" And brr(i - rw + 1, c - cc + 1) <> "住址 电话 QQ" Then
    
20.                 If rr Is Nothing Then Set rr = Cells(i, c) Else Set rr = Union(rr, Cells(i, c))
    
21.                 If rr.Areas.Count = 255 Then rr.ClearContents: Set rr = Nothing
    
22.             End If
    
23.         Next
    
24.         If Not rr Is Nothing Then rr.ClearContents
    
25.         Set rng = Myarr.FindNext(rng)
    
26.     Loop Until rng.Address = st Or rng.Row <> r
    
27.     Application.Calculation = xlCalculationAutomatic
    
28.     Application.EnableEvents = True
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码

合肥狮子

yangyangzhifeng 发表于 2013-1-5 00:45
你的工作表有太多函数，现改为数组及禁事件和改为手动重算，速度应该可以了

非常好用了！谢谢！谢谢！！！
使用注意事项：要选中矩形区域才行，不能选择几列！

合肥狮子

“自动查找清空区域”用宏真的做不到吗？

yangyangzhifeng

合肥狮子 发表于 2013-1-4 10:53
“自动查找清空区域”用宏真的做不到吗？

试试看

1. Sub 事中选定区域清空()
   
2.     Dim Myarr As Range, i&, conf1, conf2, ar
   
3.     On Error Resume Next
   
4.     conf1 = MsgBox("是否已备份？确认清空内容？", vbYesNo)
   
5.     Set Myarr = Application.InputBox("请选择清空范围", "选择", Type:=8)
   
6.     If conf1 = vbYes Then
   
7.         conf2 = InputBox("请输入确认密码", "密码输入框")
   
8.         If conf2 = "123" Then
   
9.             If Err <> 0 Then MsgBox "没有选择区域", 64, "温馨提示": Exit Sub
   
10.             ar = Split(Myarr.Address, "$")
    
11.             For i = Val(ar(2)) To Val(ar(4))
    
12.                 If Cells(i, "bg") <> "通讯录" And Cells(i, "bg") <> "住址、电话、QQ" Then Cells(i, "bg").ClearContents
    
13.             Next
    
14.         End If
    
15.     End If
    
16. End Sub
    

复制代码

合肥狮子

yangyangzhifeng 发表于 2013-1-4 11:50
试试看

谢谢您！
我选择了A1:DA2000区域，来清空通讯录，结果不行！
我不知道，不理解这个宏，也不会使用这个宏。
还请告诉我这个VBA宏的设计思路、使用方法、注意事项，谢谢！

感觉这个宏是《清空某列中非“通讯录”“住址、电话、QQ"的单元格》。

yangyangzhifeng

就是你理解的这样，不过不是某列而是只对BG列起作用

合肥狮子

yangyangzhifeng 发表于 2013-1-4 14:24
就是你理解的这样，不过不是某列而是只对BG列起作用

可是我需要的是在A1:DA2000区域内的，这个咋办？
还有你这个选择区域也没有意思呀？？？

这个宏只要把bf列修改为包含“通讯录”所在的列就行了，怎么修改？

yangyangzhifeng

合肥狮子 发表于 2013-1-4 18:07
可是我需要的是在A1:DA2000区域内的，这个咋办？
还有你这个选择区域也没有意思呀？？？

试试看

1. Sub 事中选定区域清空()
   
2.     Dim Myarr As Range, i&, conf1, conf2, ar, rng As Range, st$, c&, r&
   
3.     On Error Resume Next
   
4.     conf1 = MsgBox("是否已备份 确认清空内容 ", vbYesNo)
   
5.     Set Myarr = Application.InputBox("请选择清空范围", "选择", Type:=8)
   
6.     If Err <> 0 Then MsgBox "没有选择区域", 64, "温馨提示": Exit Sub
   
7.     conf2 = InputBox("请输入确认密码", "密码输入框")
   
8.     If conf2 <> "123" Then MsgBox "密码错误！": Exit Sub
   
9.     ar = Split(Myarr.Address, "$")
   
10.     Set rng = Myarr.Find("通讯录", lookat:=xlWhole, searchorder:=xlByRows)
    
11.     st = rng.Address: r = rng.Row
    
12.     Do
    
13.         c = rng.Column
    
14.         For i = r To Val(ar(UBound(ar)))
    
15.             If Cells(i, c) <> "通讯录" And Cells(i, c) <> "住址 电话 QQ" Then Cells(i, c).ClearContents
    
16.         Next
    
17.         Set rng = Myarr.FindNext(rng)
    
18.     Loop Until rng.Address = st Or rng.Row <> r
    
19. End Sub
    

复制代码

合肥狮子

yangyangzhifeng 发表于 2013-1-4 18:42
试试看

1、启动宏，选择A1:DA2000区域，之后就是cpu死运行不停止；
2、用任务管理器强行关闭后，选择A：DA列区域，宏没反应；
这个咋办呢？还请赐教！