On Error Resume Next
Set s1 = Sheets("批號紀錄")
r = s1.Columns(1).Find("*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row '找出最後一個日期列值
If r <= 1 Or r = "" Then s1.[a2] = Now(): r = 2 '假如都沒有日期 會從今天開始逐列增加
While DateValue(s1.Cells(r, 1)) <= DateValue(Now()) + 7 '自動填入1周後的日期
s1.Cells(r + 1, 1) = s1.Cells(r, 1) + 1
r = r + 1
Wend
rn = 0: rd = 0
rn = s1.Rows(1).Find(n1, LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlPrevious).Column '找到同名欄值 (完全比對)
rd = s1.Columns(1).Find(DateValue(n2), LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlPrevious).Row '找到同日列值 (完全比對)
If rn = 0 Then MsgBox ("查無品名" & n1): Exit Sub '姓名錯誤
If rd = 0 Then MsgBox ("查無日期" & n2): Exit Sub '日期錯誤
s1.Cells(rd, rn) = n3 '將效率值 放入查出來的位置