VBA输入框过滤器增强

Question

下面的代码工作正常。但是，如果用户没有在InputBox 或中包含任何内容，请点击“关闭”按钮或输入一个不存在的值我希望它显示msgbox，说明原因并删除工作表'PreTotal' 。

有没有更好的方式来处理用户输入？在这里需要一些关于如何去做的帮助。谢谢。

Sub Filterme() 
    Dim wSheetStart As Worksheet 
    Dim rFilterHeads As Range 
    Dim strCriteria As String 

    Set wSheetStart = ActiveSheet 
    Set rFilterHeads = Range("M1", Range("M1").End(xlToLeft)) 

    With wSheetStart 
     .AutoFilterMode = False 

     rFilterHeads.AutoFilter 

     strCriteria = InputBox("Enter Date - MMDDYY") 

     If strCriteria = vbNullString Then Exit Sub 

     rFilterHeads.AutoFilter Field:=13, Criteria1:="=*" & strCriteria & "*" 
    End With 

    Worksheets("PreTotal").UsedRange.Copy 

    Sheets.Add.Name = "Total" 

    Worksheets("Total").Range("A1").PasteSpecial 

End Sub 

Answer 1

这是你正在尝试？

变化

If strCriteria = vbNullString Then Exit Sub  

到

If strCriteria = vbNullString Then 
    MsgBox "You choose not to continue" 
    Application.DisplayAlerts = False 
    Worksheets("PreTotal").Delete 
    Application.DisplayAlerts = True 
    Exit Sub 
End If 

随访

感谢@Rout - 这个工作。还有一件事情，如果输入条件不存在于表格中？我应该如何解决这个问题？ - user823911 11分钟前

这是你想什么呢？此外，如果您是基于山口中号（1上校范围）过滤的范围内，那么改线

rFilterHeads.AutoFilter Field:=13, Criteria1:="=*" & strCriteria & "*" 

到

rFilterHeads.AutoFilter Field:=1, Criteria1:="=*" & strCriteria & "*" 

CODE

Sub Filterme() 
    Dim wSheetStart As Worksheet 
    Dim rFilterHeads As Range, aCell As Range 
    Dim strCriteria As String 

    Set wSheetStart = ActiveSheet 
    Set rFilterHeads = Range("M1", Range("M1").End(xlToLeft)) 

    With wSheetStart 
     .AutoFilterMode = False 

     strCriteria = InputBox("Enter Date - MMDDYY") 

     If strCriteria = vbNullString Then 
      MsgBox "You choose not to continue" 
      Application.DisplayAlerts = False 
      Worksheets("PreTotal").Delete 
      Application.DisplayAlerts = True 
      Exit Sub 
     End If 

     Set aCell = .Columns(13).Find(What:=strCriteria, LookIn:=xlValues, _ 
     LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False) 

     If Not aCell Is Nothing Then 
      MsgBox "Search Criteria Not Found" 
      Exit Sub 
     End If 

     rFilterHeads.AutoFilter 

     rFilterHeads.AutoFilter Field:=13, Criteria1:="=*" & strCriteria & "*" 

     Sheets.Add.Name = "Total" 
     Worksheets("PreTotal").UsedRange.Copy 
     Worksheets("Total").Range("A1").PasteSpecial 
    End With 
End Sub