返回列表 上一主題 發帖

[發問] 儲存格內有函數,但想要手動輸入時會讓原有函數不見

本帖最後由 GBKEE 於 2014-10-15 09:19 編輯

回復 3# luhpro
請參考一下
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim bNFind As Range
  4.     With Target
  5.         If .Count = 1 Then
  6.             If .Row = 1 And .Column <= 7 Then  ' A1 或 B1(星期一 到 星期日)
  7.                 .Range("A2").Resize(2) = ""
  8.                 .Range("A3").Validation.Delete
  9.                 If .Value = "" Then Exit Sub
  10.                 Application.EnableEvents = False
  11.                 Set bNFind = Sheets("工作表2").Range("A:A").Find(.Value, LookAT:=xlWhole)
  12.                 If Not bNFind Is Nothing Then
  13.                     .Offset(1) = bNFind.Range("B1")
  14.                     If 排班(bNFind.Range("C1"), Target) Then .Offset(2) = bNFind.Range("C1") & vbLf & "沒有排班"
  15.                 End If
  16.                 Application.EnableEvents = True
  17.             End If
  18.         End If
  19.     End With
  20. End Sub
  21. Private Function 排班(ByVal T1 As Range, T2 As Range) As Boolean
  22.     Dim bNFind As Range, S As String
  23.     With Sheets("工作表1")
  24.         Set bNFind = .Columns(T2.Column).Find(T1, LookAT:=xlWhole)
  25.         If Not bNFind Is Nothing Then
  26.             For Each bNFind In .Columns(T2.Column).SpecialCells(xlCellTypeConstants)
  27.                 If bNFind.Row > 1 And bNFind <> "" Then
  28.                     S = IIf(S <> "", S & "," & bNFind, bNFind)
  29.                 End If
  30.             Next
  31.         Else
  32.            排班 = True
  33.         End If
  34.         With T2.Range("A3")
  35.             If Not 排班 Then
  36.                 .Validation.Add Type:=xlValidateList, Formula1:=S
  37.                 .Value = T1
  38.             End If
  39.         End With
  40.     End With
  41. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 多做多得。少做多失。
返回列表 上一主題