- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2014-10-15 09:19 編輯
回復 3# luhpro
請參考一下- Option Explicit
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim bNFind As Range
- With Target
- If .Count = 1 Then
- If .Row = 1 And .Column <= 7 Then ' A1 或 B1(星期一 到 星期日)
- .Range("A2").Resize(2) = ""
- .Range("A3").Validation.Delete
- If .Value = "" Then Exit Sub
- Application.EnableEvents = False
- Set bNFind = Sheets("工作表2").Range("A:A").Find(.Value, LookAT:=xlWhole)
- If Not bNFind Is Nothing Then
- .Offset(1) = bNFind.Range("B1")
- If 排班(bNFind.Range("C1"), Target) Then .Offset(2) = bNFind.Range("C1") & vbLf & "沒有排班"
- End If
- Application.EnableEvents = True
- End If
- End If
- End With
- End Sub
- Private Function 排班(ByVal T1 As Range, T2 As Range) As Boolean
- Dim bNFind As Range, S As String
- With Sheets("工作表1")
- Set bNFind = .Columns(T2.Column).Find(T1, LookAT:=xlWhole)
- If Not bNFind Is Nothing Then
- For Each bNFind In .Columns(T2.Column).SpecialCells(xlCellTypeConstants)
- If bNFind.Row > 1 And bNFind <> "" Then
- S = IIf(S <> "", S & "," & bNFind, bNFind)
- End If
- Next
- Else
- 排班 = True
- End If
- With T2.Range("A3")
- If Not 排班 Then
- .Validation.Add Type:=xlValidateList, Formula1:=S
- .Value = T1
- End If
- End With
- End With
- End Function
複製代碼 |
|