1

以下のコードは正常に機能します。ただし、ユーザーがInputBoxに何も含めない場合、[閉じる]ボタンをクリックする場合、または存在しない値を入力する場合は、理由を示すメッセージボックスを表示し、シート「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
4

1 に答える 1

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-これはうまくいきました。入力基準がシートに存在しない場合はどうなりますか？どのように取り組むべきですか？–user82391111分前

これはあなたがしようとしていることですか？また、列M （範囲の最初の列）に基づいて範囲をフィルタリングしている場合は、行を変更します

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
于 2012-04-20T09:11:00.343 に答える