12
返回列表 上一主題 發帖

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

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
4# 跳轉到 »
發表於 2014-2-9 11:27 | 只看該作者
回復 3# GBKEE
每次看到大大的大作, 都有很大的收獲, 謝謝!!
但我將這篇 vba code 貼到新的 workbook 的 sheet1 內,
再到 sheet1 操作, 似乎沒有反應, 那個步驟漏掉了

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

iceandy6150

帖子
129 
主題
25 
精華
0 
積分
159 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-12-24 
最後登錄
2022-12-12 
2#
發表於 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
哈囉~大家好呀

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
12
返回列表 上一主題