macros在两个不同的列中search两个值,并使用它填充第三列中的信息

我正在创build一个时间表,我一直在寻找开发以下macros:

  • 第1列和第2列具有员工的名字和姓氏。
  • 第3列有员工编号。
  • 第5列具有每周签约的小时数(已填充)。
  • 第6列的月份结束date为星期(每个月有4或5个星期,因此每个员工有5行)。

我正在寻找的是一个macrosbutton,它会询问用户的员工号码,然后询问用户他们想要哪一周结束的date。 这应该确定一个单一的行。 基于此,我想要一个input框来修改第5列的每周小时数。

时间表将已经填充,这个function只允许修改到每周的时间。 他们不能仅仅input它的原因是因为单元格将被locking,我们不希望最终用户不必要地访问它们。

听起来啰嗦我知道,但我们有大约800张时间表分发给有不同经验的人的Excel,locking所有这些单元格,防止他们不必要地删除数据。

提前感谢任何帮助!

2012年8月14日修订:

这是我所面对的问题的最终解决scheme(由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 

完整答案:

 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