我有一个包含员工列表的电子表格。我想运行一个宏,当在输入框中输入员工编号时,该宏将过滤特定员工。但是,如果该号码不存在,我希望显示一条错误消息,让您可以选择重试。
我的尝试如下:
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
上面修改的代码