未找到自动筛选中的Criteria时所需的VBA退出代码 [英] VBA Exit code needed for when Criteria in autofilter is not found

问题描述

我有一个宏，通过电子邮件发送一系列的基于组合框选择的数据。当用户选择一个值（这在代码中变成MyValBranch）时，
然后在代码中的AutoFilter Field 31中成为Criteria1。如果它在AutoFilter范围内找不到MyValBranch变量的值，则表格会冻结，我必须通过任务管理器将其删除。



代码：

 Sub Pipeline_EmailBranchNetRegs（）
 ActiveSheet.Unprotect 
 Dim rng As Range 
 Dim OutApp As Object 
 Dim OutMail As Object 
 Dim Signature As String 
 Dim mysht As Worksheet 
 Dim myDropDown As Shape 
 Dim myValBranch As String 
 Dim RegRng As Range 
 Dim ADRng As Range 
 Dim BMRng As Range 
 Dim PrevRegRng As Range 
 
 Set mysht = ThisWorkbook.Worksheets（" Pipeline"）
 Set myDropDown = mysht.Shapes（" Drop Down 264"）
 myValBranch = myDropDown.ControlFormat.List（myDropDown.ControlFormat.Value）
如果myValBranch ="选择分支"然后
 MsgBox"请选择一个分支，然后再试一次。"，vbExclamation 
退出Sub 
结束如果
设置RegRng =工作表（"目标"）。范围（ "A：A"。查找（What：= myValBranch，LookAt：= xlWhole）
设置ADRng =工作表（"目标"）。范围（"L：L"）。查找（内容：= myValBranch，LookAt：= xlWhole）
设置BMRng =工作表（"目标"）。范围（"M：M"）。查找（What：= myValBranch，LookAt：= xlWhole）
设置PrevRegRng =工作表（"目标"）。范围（"A：A"）。查找（What：= myValBranch，LookAt：= xlWhole）
 
 If（ActiveSheet.AutoFilterMode和ActiveSheet.FilterMode）或ActiveSheet.FilterMode然后
 ActiveSheet.ShowAllData 
 End if 
 ActiveSheet.Range（" $ a $ 6：$ AQ $ 1000"）。AutoFilter Field：= 34，Criteria1：="< ;>预先核准" 
 ActiveSheet.Range（" $ A $ 6：$ AQ $ 1000"）。AutoFilter Field：= 31，Criteria1：= myValBranch 
 NumberofRegs = RegRng.Offset（0,9）.Value 
 AD = RegRng.Offset（0,11）.Value 
 BM = RegRng.Offset（0,12）.Value 
 Goal = RegRng.Offset（0,1）.Value 
 FormattedGoal =格式（目标，"＃，## 0"）
 
 PrevNumberofRegs = PrevRegRng.Offset（0,10）.Value 
 
设置rng = Nothing 
 '只发送选择中的可见单元格。 
设置rng = ActiveSheet.Range（" a6"，ActiveSheet.Range（" H6"）。End（xlDown））
 
如果rng是Nothing那么
 MsgBox" ;选择不是范围或工作表受保护。 " &安培; _ 
 vbNewLine& "请更正并重试。"，vbOKOnly 
退出Sub 
结束如果
 
使用应用
 .EnableEvents = False 
 .ScreenUpdating = False 
以
 
结束Set OutApp = CreateObject（" Outlook.Application"）
 Set OutMail = OutApp.CreateItem（0）
 OutMail 
。显示
以
结束签名​​= OutMail.HTMLBody 
 strbody ="当前管道和MTD注册计数的快照：" &安培; "< br />" &安培; "当前月目标=" &安培; "$" &安培; FormattedGoal& "< br />" &安培; ActiveSheet.Range（" A1"）& " " &安培; ActiveSheet.Range（" B1"）& "< br />" &安培; ActiveSheet.Range（" A2"）&拆分（ActiveSheet.Range（" B2"）。Text，"。"）（0）& "< br />" &安培; "上个月注册计数=" &安培; PrevNumberofRegs& "< br />" &安培; "MTD注册计数=" &安培; NumberofRegs 
'Slav（ActiveSheet.Range（" B2"）。Text，"。"）（0）
 With OutMail 
 .to = BM 
 .cc = AD 
 .Subject = myValBranch& " - " &安培; "Net Reg Pipeline" 
 .HTMLBody ="< BODY style = font-size：11pt; font-family：Calibri>" &安培; "< / p为H." &安培; strbody& RangetoHTML（rng）&签名
。显示
结束时
 
错误GoTo 0 
 
应用程序
 .EnableEvents = True 
 .ScreenUpdating =真
结束
 
 Set OutMail = Nothing 
 Set OutApp = Nothing 
 ActiveSheet.Protect 
 
 End Sub 

解决方案

Hi MEC，

>>如果它没有在AutoFilter范围内找到MyValBranch变量的值，则表格会冻结，我必须通过任务管理器终止它。

你的意思是MyValBranch的值在范围内不存在会使您的工作表冻结吗？我使用AutoFilter进行了测试，并将Criteria1设置为不存在的值，它可以正常工作。

要检查您的问题是否与AutoFilter有关，我建议您注释掉这一行"ActiveSheet.Range（"

A

6

I have a macro that emails a range of data based on the combobox selection.When the user selects a value (this becomes MyValBranch in the code) which then becomes Criteria1 in my AutoFilter Field 31 in the code . If it does not find the value of the MyValBranch variable in the AutoFilter range the sheet freezes and I have to kill it though task manager.

Code:

Sub Pipeline_EmailBranchNetRegs()
ActiveSheet.Unprotect
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Dim mysht As Worksheet
Dim myDropDown As Shape
Dim myValBranch As String
Dim RegRng As Range
Dim ADRng As Range
Dim BMRng As Range
Dim PrevRegRng As Range

Set mysht = ThisWorkbook.Worksheets("Pipeline")
Set myDropDown = mysht.Shapes("Drop Down 264")
myValBranch = myDropDown.ControlFormat.List(myDropDown.ControlFormat.Value)
If myValBranch = "Choose Branch" Then
        MsgBox "Please Choose a Branch, then try again.", vbExclamation
        Exit Sub
    End If
Set RegRng = Worksheets("Goals").Range("A:A").Find(What:=myValBranch, LookAt:=xlWhole)
Set ADRng = Worksheets("Goals").Range("L:L").Find(What:=myValBranch, LookAt:=xlWhole)
Set BMRng = Worksheets("Goals").Range("M:M").Find(What:=myValBranch, LookAt:=xlWhole)
Set PrevRegRng = Worksheets("Goals").Range("A:A").Find(What:=myValBranch, LookAt:=xlWhole)

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
ActiveSheet.Range("$a$6:$AQ$1000").AutoFilter Field:=34, Criteria1:="<>Pre-Approval"
ActiveSheet.Range("$A$6:$AQ$1000").AutoFilter Field:=31, Criteria1:=myValBranch
NumberofRegs = RegRng.Offset(0, 9).Value
AD = RegRng.Offset(0, 11).Value
BM = RegRng.Offset(0, 12).Value
Goal = RegRng.Offset(0, 1).Value
FormattedGoal = Format(Goal, "#,##0")

PrevNumberofRegs = PrevRegRng.Offset(0, 10).Value

Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))

If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
   .Display
End With
Signature = OutMail.HTMLBody
strbody = "Snapshot of Current Pipeline and MTD Registration Count:" & "<br />" & "Current Month Goal = " & "$ " & FormattedGoal & "<br />" & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("B1") & "<br />" & ActiveSheet.Range("A2") & Split(ActiveSheet.Range("B2").Text, ".")(0) & "<br />" & "Previous Month Registration Count = " & PrevNumberofRegs & "<br />" & "MTD Registration Count = " & NumberofRegs
'Split(ActiveSheet.Range("B2").Text, ".")(0)
With OutMail
    .to = BM
    .cc = AD
    .Subject = myValBranch & " - " & "Net Reg Pipeline"
    .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
    .Display
End With

On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
ActiveSheet.Protect

End Sub

解决方案

Hi MEC,

>> If it does not find the value of the MyValBranch variable in the AutoFilter range the sheet freezes and I have to kill it though task manager

Do you mean the value of MyValBranch which is not exist in range make your sheet freezes? I made a test with AutoFilter and set Criteria1 with a non-exist value, it works correctly.

To check whether your issue is related with AutoFilter, I would suggest you comment out this line "ActiveSheet.Range("

A

6:

这篇关于未找到自动筛选中的Criteria时所需的VBA退出代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！