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