Question

我正在创建一个时间表，我一直在寻找为以下内容开发宏：

第1栏和第1栏2有员工的名字和姓氏。
第3列有员工编号。
第5列包含每周合约时数（已填充）。
第6列包含该月的截止日期（每月有4或5周，因此每位员工有5行）。

我正在寻找的是一个宏按钮，它会询问用户的员工编号，然后询问用户他们想要哪个周结束日期。这应该标识一行。基于此，我想要一个输入框来修改第5列中的每周小时数。

时间表已经填充，此功能只允许对每周工作时间进行修改。他们不能只输入它的原因是因为单元格将被锁定，我们不希望最终用户不必要地访问它们。

听起来很啰嗦我知道，但我们有大约800次表格分发给具有不同Excel经验的人，锁定所有这些单元格会阻止他们不必要地删除数据。

提前感谢您的帮助！

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

Answer 1

完整答案：

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

用于在两个不同列中搜索两个值并使用它填充第三列中的信息的宏

1 个答案: