1

私はタイムシートを作成していて、次のマクロを開発しようとしています。

  • 列1と2には、従業員の名前と名前があります。
  • 列3には従業員番号があります。
  • 列5には、毎週の契約時間があります（すでに入力されています）。
  • 列6には、その月の週の終了日があります（1か月に4週間または5週間あるため、従業員ごとに5行あります）。

私が探しているのは、ユーザーに従業員番号を尋ね、次にどの週の終了日を希望するかをユーザーに尋ねるマクロボタンです。これにより、単一の行が識別されます。これに基づいて、入力ボックスで列5の週単位の時間数を修正したいと思います。

タイムシートはすでに入力されており、この関数は毎週の時間にのみ修正を行うことができます。単に入力できない理由は、セルがロックされ、エンドユーザーが不必要にセルにアクセスすることを望まないためです。

長い間聞こえますが、Excelのさまざまな経験を持つ人々に配布するために、約800のタイムシートがあります。これらのセルをすべてロックすると、データが不必要に削除されるのを防ぐことができます。

助けてくれてありがとう！

2012年8月14日の改訂：

これが私が抱えていた問題の最終的な解決策です（Siddarth Routの提供）。これは素晴らしくうまく機能し、Excelの初心者が快適に使用できるようにするためのパラメーターがたくさんあります。 

 Private Sub AmendWeeklyHoursCommandButton_Click()

 Unload AmendEmployeeUserForm

 ' Turn off screen updating to speed up macro.
 Application.ScreenUpdating = False

 ActiveSheet.Unprotect Password:="control"

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

Continue = True

Do While Continue = True
 Again: EmployeeNumber = InputBox("Please enter the employee number:", "Amend the employee's weekly contracted hours")

 If StrPtr(EmployeeNumber) = 0 Then
        ActiveSheet.Protect Password:="control"
        AmendEmployeeUserForm.Show
        '~~> 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?") = vbYes Then GoTo Again
                    If vbNo Then Range("G6").Select
                    ActiveSheet.Protect Password:="control"
                    AmendEmployeeUserForm.Show
                    Exit Sub

                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
 Again1:        WeekEnding = InputBox("Please enter the week ending date:", "Amend the employee's weekly contracted hours")

 If StrPtr(WeekEnding) = 0 Then
        '~~> User pressed cancel
        ActiveSheet.ShowAllData
        Range("G6").Select
        ActiveSheet.Protect Password:="control"
        AmendEmployeeUserForm.Show
        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?") = vbYes Then GoTo Again1
                    If vbNo Then ActiveSheet.ShowAllData
                    Range("G6").Select
                    ActiveSheet.Protect Password:="control"
                    AmendEmployeeUserForm.Show
                    Exit Sub

                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
        Range("G6").Select
        ActiveSheet.Protect Password:="control"
        AmendEmployeeUserForm.Show
        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 "You have successfully amended the details for " & aCell.Offset(0, -1).Value     & " " & aCell.Offset(0, -2).Value

'Show all data
ActiveSheet.ShowAllData

 ActiveSheet.Protect Password:="control"

 Application.ScreenUpdating = True

 Range("G6").Select

 End Sub
4

1 に答える 1

0

完全な答え：

Private Sub AmendWeeklyHoursCommandButton_Click()

Unload AmendEmployeeUserForm

 ' Turn off screen updating to speed up macro.
 Application.ScreenUpdating = False

 ActiveSheet.Unprotect Password:="control"

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

 Continue = True

 Do While Continue = True
  Again: EmployeeNumber = InputBox("Please enter the employee number:", "Amend the      employee's weekly contracted hours")

  If StrPtr(EmployeeNumber) = 0 Then
    ActiveSheet.Protect Password:="control"
    AmendEmployeeUserForm.Show
    '~~> 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?") = vbYes Then GoTo Again
                If vbNo Then Range("G6").Select
                ActiveSheet.Protect Password:="control"
                AmendEmployeeUserForm.Show
                Exit Sub

            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
 Again1:        WeekEnding = InputBox("Please enter the week ending date:", "Amend the employee's weekly contracted hours")

 If StrPtr(WeekEnding) = 0 Then
    '~~> User pressed cancel
    ActiveSheet.ShowAllData
    Range("G6").Select
    ActiveSheet.Protect Password:="control"
    AmendEmployeeUserForm.Show
    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?") = vbYes Then GoTo Again1
                If vbNo Then ActiveSheet.ShowAllData
                Range("G6").Select
                ActiveSheet.Protect Password:="control"
                AmendEmployeeUserForm.Show
                Exit Sub

            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
    Range("G6").Select
    ActiveSheet.Protect Password:="control"
    AmendEmployeeUserForm.Show
    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 "You have successfully amended the details for " & aCell.Offset(0, -1).Value     & " " & aCell.Offset(0, -2).Value

 'Show all data
 ActiveSheet.ShowAllData

 ActiveSheet.Protect Password:="control"

 Application.ScreenUpdating = True

 Range("G6").Select

 End Sub
于 2013-01-09T11:54:01.153 に答える