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

newlink

小弟為使維修資料建檔快速、正確，需求以下涵數設計
       A       B          C         D
1  保固  金額  報價日  同意日
2
3

A欄有下拉選單，分別是：保內、二修、保外、人為
當A2選擇保內or二修，B2  C2  D2會自動填上 -- ，因為不能有金額，也不會報價
當A2選擇保外or人為，B2自動填上”填金額”做為收費提醒，
當B2改填上報價金額時，C2自動填上TODAY日期

附上檔案，請高手指點，感謝！

iceandy6150

回復 1# newlink

哈哈，我是菜鳥，寫了陽春版的
可是要怎麼讓程式能一直執行，我不會
如果設一個按鈕，每按一次，可以使用一次，只針對第二列

要怎麼隨時隨著表格輸入就馬上跳動，我不會，還要再修改

Sub ex()

Dim i
i = Sheets("工作表1").Cells(2, 1).Value
MsgBox (i)

If i = "" Then
Exit Sub

   ElseIf i = "保內" Then

        Sheets("工作表1").Cells(2, 2).Value = "--"
        Sheets("工作表1").Cells(2, 3).Value = "--"
        Sheets("工作表1").Cells(2, 4).Value = "--"
        
   ElseIf i = "二修" Then

        Sheets("工作表1").Cells(2, 2).Value = "--"
        Sheets("工作表1").Cells(2, 3).Value = "--"
        Sheets("工作表1").Cells(2, 4).Value = "--"
   
  
   ElseIf i = "保外" Then

       If Sheets("工作表1").Cells(2, 2).Value = "" Then
        Sheets("工作表1").Cells(2, 2).Value = "填金額"
       End If
        
       If Sheets("工作表1").Cells(2, 2).Value <> "" Then
        Sheets("工作表1").Cells(2, 3).Value = "=Today()"
       End If
   
Else

       If Sheets("工作表1").Cells(2, 2).Value = "" Then
        Sheets("工作表1").Cells(2, 2).Value = "填金額"
       End If
        
       If Sheets("工作表1").Cells(2, 2).Value <> "" Then
        Sheets("工作表1").Cells(2, 3).Value = "=Today()"
       End If

End If

End Sub

GBKEE

回復 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. 
    
22. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
23.     'SelectionChange :工作表儲存格 有移動時所觸發的程序
    
24.     If Not Application.Intersect(Range("a:a"), Target) Is Nothing Then  '儲存格移動到A欄時
    
25.         Range("a:a").Validation.Delete
    
26.         Target(1).Validation.Add xlValidateList, , , "保內,二修,保外,人為"
    
27.         'Validation 物件，該物件代表指定範圍內的資料驗證(輸入的資料要符合指定的資料)
    
28.         'A欄有下拉選單，分別是：保內、二修、保外、人為
    
29.     End If
    
30. End Sub

複製代碼

yen956

回復 3# GBKEE
每次看到大大的大作, 都有很大的收獲, 謝謝!!
但我將這篇 vba code 貼到新的 workbook 的 sheet1 內,
再到 sheet1 操作, 似乎沒有反應, 那個步驟漏掉了

GBKEE

回復 4# yen956
不要貼在一般模組

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.                 '***SelectionChange :工作表儲存格 有移動時所觸發的程序 ****
   
3.                 '有移動才有觸發請->,先移動儲存格在A欄之外,再移動儲存格到A欄內看看

複製代碼

yen956

回復 5# GBKEE
感謝GBKEE大大的回覆,
但是我就是貼在 sheet1 的程式區, 但不管用, 不知哪裡有問題.
(我只是說模組也試過)
檔案如上:

yen956

回復 5# GBKEE
萬分抱歉ㄝ, 剛剛又試了一下, 已經能照你的設計執行, 萬分感謝,
(最近電腦怪怪的, 剛剛才重新還原, 實在抱歉)

Hsieh

回復 1# newlink

下載 (61.61 KB)

2014-2-9 19:25

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. With Target(1)
   
3.   Select Case .Column
   
4.   Case 1
   
5.   .Offset(, 1).Resize(, 3) = IIf(.Value = "保內" Or .Value = "二修", "--", "填金額")
   
6.   Case 2
   
7.   .Offset(, 1).Resize(, 2) = IIf(IsNumeric(.Value) And .Value <> "", Date, "")
   
8.   End Select
   
9. End With
   
10. End Sub
    
11. 
    
12. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
13. If Target(1).Column = 1 Then '選取A欄
    
14. With Target(1).Validation '設定驗證清單
    
15.   .Delete
    
16.    .Add xlValidateList, , , "保內,二修,保外,人為"
    
17. End With
    
18. End If
    
19. End Sub

複製代碼

yen956

回復 5# GBKEE
                   【 '***SelectionChange :工作表儲存格 有移動時所觸發的程序 ****
                    '有移動才有觸發請->,先移動儲存格在A欄之外,再移動儲存格到A欄內看看】
謝謝再三說明, 收到.
再次請問：
    【Private Sub Worksheet_SelectionChange(ByVal Target As Range)】
所以 Worksheet_SelectionChange後所觸發的第一個Range就是Target(1)是不是?

GBKEE

回復 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

複製代碼