Board logo

標題: [發問] 求高手解答依條件辨別自動輸入儲存格 [打印本頁]
作者: newlink    時間: 2014-2-8 21:48     標題: 求高手解答依條件辨別自動輸入儲存格

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

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

附上檔案，請高手指點，感謝！
作者: iceandy6150    時間: 2014-2-8 23:10

本帖最後由 iceandy6150 於 2014-2-8 23:11 編輯

回復 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    時間: 2014-2-9 07:20

本帖最後由 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

  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    時間: 2014-2-9 11:27

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

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

回復 4# yen956
不要貼在一般模組
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.                 '***SelectionChange :工作表儲存格 有移動時所觸發的程序 ****
  3.                 '有移動才有觸發請->,先移動儲存格在A欄之外,再移動儲存格到A欄內看看
複製代碼
作者: yen956    時間: 2014-2-9 18:52

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

回復 5# GBKEE
萬分抱歉ㄝ, 剛剛又試了一下, 已經能照你的設計執行, 萬分感謝,
(最近電腦怪怪的, 剛剛才重新還原, 實在抱歉)
作者: Hsieh    時間: 2014-2-9 19:21

本帖最後由 Hsieh 於 2014-2-9 19:25 編輯

回復 1# newlink
[attach]17456[/attach]
  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

  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    時間: 2014-2-9 19:24

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

回復 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
複製代碼
作者: newlink    時間: 2014-2-9 21:45

版主大大您好，本來以為這用涵數就可以搞定，我不會巨集，但還是試著改看看，增加了原來希望：如果下拉選保內or二修，B2、C2、D2都自動填上--，以便做為不收費提醒，但是改過後怪怪的，下拉選保外or人為，不會照原來的設定那樣，請教我
作者: newlink    時間: 2014-2-9 22:04

回復 10# GBKEE

天啊！我原來以為這只需要用涵數就能解決，沒想到是巨集，我沒學過，
不過我試過，是可以用，只是原來希望選保內或二修時，B  C  D都填上--，現在只有B填上
太神奇了，只要幾行字就能搞定
就怕我不知所以然，應用到其它地方有困難

但是，應該對懂的人很有用，也是好事！
作者: yen956    時間: 2014-2-10 12:10

謝謝大大在百忙中再次指導,
但是這裡用的是Target
   【 Option Explicit
    Sub Ex()  '執行此程式會觸動 Worksheet_SelectionChange(ByVal Target As Range)
        [D5:E6].Select
    End Sub
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)   'Target-> [D56]
        Dim i
        MsgBox Target.Address
        For i = 1 To Target.Count
            MsgBox "Target.Cells(" & i & ") ->" & Target.Cells(i).Address '=> MsgBox Target.(i).Address
        Next
        [B6].Select
    End Sub】

而3樓用了 Target 及 Target(1)

我想問的是Target是不是觸動 Worksheet_SelectionChange的集合(陣列),
而Target(1)是這集合(陣列)的第一個元素?

也就是說何時用Target, 何時用Target(1)? 有可能Target(2)嗎?



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)