返回列表 上一主題 發帖

[發問] 求高手解答依條件辨別自動輸入儲存格

本帖最後由 GBKEE 於 2014-2-9 07:34 編輯

回復 1# newlink
這工作表模組預設的觸動程式碼
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     'Change : 工作表資料有變動時所觸發的程序
  4.     Application.EnableEvents = False
  5.     Select Case Target(1).Column
  6.     Case 1
  7.         '當A2選擇保外or人為,B2自動填上”填金額”做為提醒,
  8.         If Target(1) = "保外" Or Target(1) = "人為" Then Cells(Target(1).Row, "B") = "填金額"
  9.         
  10.     Case 2
  11.         '當B2改填上報價金額時 , C2自動填上TODAY日期
  12.         If IsNumeric(Target(1)) And Target(1) > 0 Then
  13.             Cells(Target(1).Row, "C") = Date
  14.         Else            '不是數字且<0
  15.             Target(1) = "填金額"
  16.             Cells(Target(1).Row, "C") = ""
  17.         End If
  18.     End Select
  19.     Application.EnableEvents = True
  20. End Sub

  21. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  22.     'SelectionChange :工作表儲存格 有移動時所觸發的程序
  23.     If Not Application.Intersect(Range("a:a"), Target) Is Nothing Then  '儲存格移動到A欄時
  24.         Range("a:a").Validation.Delete
  25.         Target(1).Validation.Add xlValidateList, , , "保內,二修,保外,人為"
  26.         'Validation 物件,該物件代表指定範圍內的資料驗證(輸入的資料要符合指定的資料)
  27.         'A欄有下拉選單,分別是:保內、二修、保外、人為
  28.     End If
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2014-2-9 18:34 編輯

回復 4# yen956
不要貼在一般模組
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.                 '***SelectionChange :工作表儲存格 有移動時所觸發的程序 ****
  3.                 '有移動才有觸發請->,先移動儲存格在A欄之外,再移動儲存格到A欄內看看
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 9# yen956
  1. Option Explicit
  2. Sub Ex()  '執行此程式會觸動 Worksheet_SelectionChange(ByVal Target As Range)
  3.     [D5:E6].Select
  4. End Sub
  5. Private Sub Worksheet_SelectionChange(ByVal Target As Range)   'Target-> [D5:D6]
  6.     Dim i
  7.     MsgBox Target.Address
  8.     For i = 1 To Target.Count
  9.         MsgBox "Target.Cells(" & i & ") ->" & Target.Cells(i).Address '=> MsgBox Target.(i).Address
  10.     Next
  11.     [B6].Select
  12. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 我們最大的敵人不是別人.可能是自己。
返回列表 上一主題