1

従業員のリストが記載されたスプレッドシートがあります。入力ボックスに従業員番号が入力されたときに特定の従業員をフィルタリングするマクロを実行したいと思います。ただし、番号が存在しない場合は、再試行のオプションを提供するエラーメッセージを表示したいと思います。

私の試みは以下の通りです：

Option Explicit

Sub AmendWeeklyHours()

'Find employee number
Dim EmployeeNumber As String
Dim Continue As Boolean
Dim aCell As Range

Continue = True

Do While Continue = True
    EmployeeNumber = InputBox("Please enter the employee number", "Enter Employee Number")

If StrPtr(EmployeeNumber) = 0 Then
        '~~> User pressed cancel
        Exit Sub
    Else
        '~~> User pressed OK with something filled
        If EmployeeNumber <> "" Then
            With ActiveSheet
                Set aCell = .Columns(3).Find(What:=EmployeeNumber, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    Selection.AutoFilter field:=3, Criteria1:=EmployeeNumber
                    Continue = False
                'If an invalid entry is entered
                Else
                    If MsgBox("You entered an invalid employee number - Try again?", _
                    vbYesNo + vbQuestion, "Search again?") = vbNo Then Exit Sub
                    Continue = False
                End If
            End With
        '~~> User pressed OK WITHOUT anything filled
        Else
            MsgBox "You didn't enter a value. Please enter the employee number or press cancel."
            Continue = True
        End If
    End If
Loop


'Find Week Ending Date
Dim WeekEnding As String
Dim Continue1 As Boolean
Dim bCell As Range

Continue1 = True

Do While Continue1 = True
    WeekEnding = InputBox("Please enter the week ending date", "Enter Week Ending Date")

If StrPtr(WeekEnding) = 0 Then
        '~~> User pressed cancel
        ActiveSheet.ShowAllData
        Exit Sub
    Else
        '~~> User pressed OK with something filled
        If WeekEnding <> "" Then
            With ActiveSheet
                Set bCell = .Columns(6).Find(What:=WeekEnding, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not bCell Is Nothing Then
                    Selection.AutoFilter field:=6, Criteria1:=WeekEnding
                    Continue1 = False
                Else
                'If an invalid entry is entered
                    If MsgBox("You entered an invalid week ending date - Try again?", _
                    vbYesNo + vbQuestion, "Search again?") = vbNo Then Exit Sub
                    Continue1 = False
                End If
            End With
        Else
            '~~> User pressed OK WITHOUT anything filled
            MsgBox "You didn't enter a value. Please enter the week ending date or press cancel."
            Continue1 = True
        End If
    End If
Loop

'Control + home
Dim Rng As Range
With ActiveSheet.AutoFilter
    Set Rng = .Range.Offset(1, 0).Resize(.Range.Rows.Count - 1)
    Rng.SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
End With

'Select hours column
ActiveCell.Offset(0, 4).Activate

'Enter hours
Dim NewHours As String
Dim Continue2 As Boolean

Continue2 = True

Do While Continue2 = True
NewHours = InputBox("Please enter the new hours", "Enter New Contracted Hours")

If StrPtr(NewHours) = 0 Then
        '~~> User pressed cancel
        ActiveSheet.ShowAllData
        Exit Sub

        'User pressed OK WITH something filled
        ElseIf NewHours <> "" Then
        ActiveCell = NewHours
        Continue2 = False
    Else
        '~~> User pressed OK WITHOUT anything filled
        MsgBox "You didn't enter a value. Please enter the number of hours or press cancel."
        Continue2 = True
End If
Loop

'Completion message
MsgBox ("Hours have been amended")

'Show all data
ActiveSheet.ShowAllData    
End Sub

上記の改訂されたコード

4

1 に答える 1

3

ユーザーに番号を入力してもらいたい場合の1つの方法を次に示します

Option Explicit

Sub Sample()
    Dim EmployeeNumber As String
    Dim Continue As Boolean
    Dim aCell As Range

    Continue = True

    Do While Continue = True
        EmployeeNumber = InputBox("Please enter the assignment number")

        If EmployeeNumber <> "" Then             
            With Sheets("Sheet1")
                '~~> Change .Columns(1) to the relevant range
                Set aCell = .Columns(1).Find(What:=EmployeeNumber, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    '~~> Rest of your code
                    'Selection.AutoFilter field:=3, Criteria1:=FindVal1
                Else
                    If MsgBox("You entered an invalid employee number - Try again?", _
                    vbYesNo + vbQuestion, "Search again?") = vbNo Then _
                    Continue = False
                End If
            End With
        Else
            Continue = False
        End If
    Loop
End Sub

ファローアップ

Sub Sample()
    Dim EmployeeNumber As String
    Dim Continue As Boolean
    Dim aCell As Range

    Continue = True

    Do While Continue = True
        EmployeeNumber = InputBox("Please enter the assignment number")

        If StrPtr(EmployeeNumber) = 0 Then
            '~~> User pressed cancel
            Exit Sub
        Else
            '~~> User pressed OK with something filled
            If EmployeeNumber <> "" Then
                With Sheets("Sheet1")
                    Set aCell = .Columns(3).Find(What:=EmployeeNumber, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

                    If Not aCell Is Nothing Then
                        Selection.AutoFilter field:=3, Criteria1:=EmployeeNumber
                        Continue = False
                    Else
                        If MsgBox("You entered an invalid employee number - Try again?", _
                        vbYesNo + vbQuestion, "Search again?") = vbNo Then _
                        Continue = False
                    End If
                End With
            '~~> User pressed OK WITHOUT anything filled
            Else
                Msgbox "You didn't enter anything. Please enter the employee number in the next box which pops up"
                Continue = True
            End If
        End If
    Loop
End Sub
于 2012-07-02T17:30:32.743 に答える