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 分钟前

这是你正在尝试的吗？此外，如果您根据 Col M（范围内的第一个 Col）过滤范围，则更改行

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

到

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

代码

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