將學生學號、班級、座號、姓名製作成stu表
另存為 .xlsm（啟用巨集）
開發人員 → Visual Basic → 在「目標工作表」的程式碼視窗貼上以下內容：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, chk As Range
Set chk = Intersect(Target, Range("A2:A1048576"))
If chk Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In chk
If r.Value <> "" And Cells(r.Row, "E").Value = "" Then
Cells(r.Row, "E").Value = Now
End If
Next r
Application.EnableEvents = True
End Sub
將 E 欄套用格式：yyyy/mm/dd hh:mm:ss
效果：從 A3 起輸入任意內容，E 欄即蓋上當下日期時間；E 已有值則不覆寫。
現在把需求擴充為：A 欄輸入學號 → 對照 stu 表（A:學號，B:班級，C:座號，D:姓名）→ 回填到 輸入表 B:班級、C:座號、D:姓名，並在 E 欄做一次性時間戳記。
將以下程式碼放到「要輸入學號的那張工作表」
Option Explicit
'=== 可依需要調整的設定 ===
Private Const STU_SHEET As String = "stu" '對照表工作表名稱
Private Const ID_LEN As Long = 0 '學號固定長度；0=不補零，例：8 代表補到8位
Private Const COL_ID As String = "A" 'stu 的學號欄位
Private Const COL_CLASS As String = "B" 'stu 的班級欄位
Private Const COL_SEAT As String = "C" 'stu 的座號欄位
Private Const COL_NAME As String = "D" 'stu 的姓名欄位
'==========================================
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitHandler
Dim chk As Range, r As Range
Dim wsStu As Worksheet
Dim lastRow As Long
Dim idVal As String
Dim found As Range
Dim findRange As Range
'只監聽 A2:A 之後的變更
Set chk = Intersect(Target, Me.Range("A2:A" & Me.Rows.Count))
If chk Is Nothing Then Exit Sub
Application.EnableEvents = False
Set wsStu = ThisWorkbook.Worksheets(STU_SHEET)
lastRow = wsStu.Cells(wsStu.Rows.Count, COL_ID).End(xlUp).Row
If lastRow < 2 Then GoTo ExitHandler
Set findRange = wsStu.Range(COL_ID & "2:" & COL_ID & lastRow)
For Each r In chk.Cells
If Len(r.Value) > 0 Then
'轉字串避免前導0遺失，必要時補零
idVal = CStr(r.Value)
If ID_LEN > 0 Then idVal = Right(String$(ID_LEN, "0") & idVal, ID_LEN)
Set found = findRange.Find(What:=idVal, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not found Is Nothing Then
'B:班級、C:座號、D:姓名
Me.Cells(r.Row, "B").Value = wsStu.Cells(found.Row, COL_CLASS).Value
Me.Cells(r.Row, "C").Value = wsStu.Cells(found.Row, COL_SEAT).Value
Me.Cells(r.Row, "D").Value = wsStu.Cells(found.Row, COL_NAME).Value
Else
'查無學號 → 清空 B~D
Me.Cells(r.Row, "B").Resize(1, 3).ClearContents
End If
'E 欄一次性時間戳記（空白才寫入）
If IsEmpty(Me.Cells(r.Row, "E").Value) Then
Me.Cells(r.Row, "E").Value = Now
Me.Cells(r.Row, "E").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
End If
Else
'清空 A 欄時，順帶清空 B~D（避免殘留）
Me.Cells(r.Row, "B").Resize(1, 3).ClearContents
'若也要清 E 欄，取消下一行註解
'Me.Cells(r.Row, "E").ClearContents
End If
Next r
ExitHandler:
Application.EnableEvents = True
End Sub另存為 .xlsm，工作表分頁(輸入表)→滑鼠右鍵〔檢視程式碼〕貼上
貼上後顯示如下表，按下儲存鍵
A3輸入學生學號，按下Enter鍵，自動顯示班級、座號、姓名及進入學校時間
最後將stu表隱藏，這樣就不會更動到學生資料，以後要增加學生資料，只要取消隱藏即可
