Private Sub Worksheet_Change(ByVal Target As Range)
' 检查是否在“首页”工作表上,并且检查A1或B1单元格的变化
If Not Intersect(Target, Me.Range("A1:B1")) Is Nothing Then
Dim monthName As String
Dim personName As String
Dim ws As Worksheet
Dim foundCell As Range
Dim searchRange As Range
Dim lastRow As Long
' 获取月份名称和名字
monthName = Me.Range("A1").Value
personName = Me.Range("B1").Value
' 检查是否选择了月份并输入了名字
If monthName <> "" And personName <> "" Then
' 检查是否存在该月份的工作表
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(monthName)
On Error GoTo 0
If Not ws Is Nothing Then
' 查找月份工作表中的名字
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set searchRange = ws.Range("A1:A" & lastRow)
Set foundCell = searchRange.Find(What:=personName, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundCell Is Nothing Then
' 清除原有的填充颜色
ws.Cells.Interior.ColorIndex = xlNone
' 跳转到找到的单元格所在的行,并填充颜色
ws.Activate
foundCell.EntireRow.Interior.Color = RGB(255, 255, 0) ' 黄色填充
Application.Goto foundCell, True
Else
MsgBox "未找到该名字,请检查输入。"
End If
Else
MsgBox "月份表格不存在,请选择有效的月份。"
End If
End If
End If
End Sub
试试