12
返回列表 上一主題 發帖

[發問] 如何利用VBA按鍵，將指定日期填滿顏色?

RCRG
　暱稱: RCRG滾奶滾企

中學生Rank: 2

帖子
95 
主題
24 
精華
0 
積分
118 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
註冊時間
2015-11-10 
最後登錄
2020-5-25 
9# 跳轉到 »
發表於 2016-11-18 21:05 | 只看該作者
回復 6# 葉國洲
回復  葉國洲


恩恩，有了！
所以C1欄一定要是 "真的" 今天日期，VBA才會觸發嗎? 如果是輸入其他日期來 ...
RCRG 發表於 2016-11-18 10:48



另外，我想更動的原問題內容，在此附上圖片與檔案，如下；
   異動問題詳細內容       
C欄(C3開始)同一種料號裡，對應F欄若"只有" 現在之後時間 "即C1欄的=NOW()" 的日期(最小時間單位會到分秒)，則填滿紅色；       
對應F欄若 "只有" 現在之後時間與現在之前時間，共兩種日期 或 "只有" 同種今天日期但兩個現在時間前後時間點，則填滿粉紅色；       



異動後附件
異動版_如何利用VBA按鍵，將指定日期填滿顏色.rar (16.47 KB)

TOP

RCRG
　暱稱: RCRG滾奶滾企

中學生Rank: 2

帖子
95 
主題
24 
精華
0 
積分
118 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
註冊時間
2015-11-10 
最後登錄
2020-5-25 
8#
發表於 2016-11-18 20:19 | 只看該作者
回復 6# 葉國洲

異常2
如下圖，在A欄 "例外篩選料號" 處，輸入該料號，應該是會忽略所有條件而不反紅或反粉紅，但是該筆卻反粉紅色了
   

TOP

RCRG
　暱稱: RCRG滾奶滾企

中學生Rank: 2

帖子
95 
主題
24 
精華
0 
積分
118 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
註冊時間
2015-11-10 
最後登錄
2020-5-25 
7#
發表於 2016-11-18 20:13 | 只看該作者
回復 6# 葉國洲

異常1
如下圖，這邊是不該出現反紅的，因為只有"今天"日期才需反紅，但該料號是有多種日期的。

TOP

葉國洲

帖子
31 
主題
0 
精華
0 
積分
31 
點名
0  
作業系統
win10 
軟體版本
office 2016 
閱讀權限
10 
性別
男 
註冊時間
2016-10-4 
最後登錄
2017-10-17 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2016-11-18 13:59 | 只看該作者
回復 5# RCRG
我完全沒有考慮到C1儲存格,C1有任何變動是不會影響到程式的
有要做修改的部分,請隨附件上模擬你要的結果,光字面上說明,有
時不一定每個人都能明白你真正的需求,或有時別人會誤解你的恴思

TOP

RCRG
　暱稱: RCRG滾奶滾企

中學生Rank: 2

帖子
95 
主題
24 
精華
0 
積分
118 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
註冊時間
2015-11-10 
最後登錄
2020-5-25 
5#
發表於 2016-11-18 10:48 | 只看該作者
回復 4# 葉國洲

恩恩，有了！
所以C1欄一定要是 "真的" 今天日期，VBA才會觸發嗎? 如果是輸入其他日期來 "假設" 為今天，這樣就不行嗎?
對了C1這欄位我想用鎖定把它保護起來，怕人家去修改到，但一鎖定VBA好像就跑不了了，能幫解決嗎?

另外 "篩選例外料號" 好像有點問題，我在A欄填入要忽略的料號，但其他料號也跟著受影響而不見了！晚上我再把圖片貼上來；

最後我的原問題想要再做點修改，不知可不可以，如下紅色字部分

問題詳細內容
C欄(C3開始)同一種料號裡，對應F欄若只有今天日期(或今天以後的日期)，則填滿紅色；
對應F欄若 "只有" 今天(或今天以後日期)與任一天，兩種日期，則填滿粉紅色(將任一天日期填滿粉紅色即可)；

反正就是今天以後日期(含今天)，都當成是今天就對了，晚上我也會一起附異動檔上來；

在此也先謝謝葉大了！

TOP

葉國洲

帖子
31 
主題
0 
精華
0 
積分
31 
點名
0  
作業系統
win10 
軟體版本
office 2016 
閱讀權限
10 
性別
男 
註冊時間
2016-10-4 
最後登錄
2017-10-17 

論壇榮譽勳章論壇贊助勳章
4#
發表於 2016-11-18 01:49 | 只看該作者
測試資料𥚃沒有當天日期，所以不會填充顏色
請自行輸入當天日期，再執行程式

TOP

RCRG
　暱稱: RCRG滾奶滾企

中學生Rank: 2

帖子
95 
主題
24 
精華
0 
積分
118 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
註冊時間
2015-11-10 
最後登錄
2020-5-25 
3#
發表於 2016-11-17 23:21 | 只看該作者
回復 2# 葉國洲

請問我把您的VBA貼在模組後執行，但似乎不行呢? 是我手法有錯誤嗎?

TOP

葉國洲

帖子
31 
主題
0 
精華
0 
積分
31 
點名
0  
作業系統
win10 
軟體版本
office 2016 
閱讀權限
10 
性別
男 
註冊時間
2016-10-4 
最後登錄
2017-10-17 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2016-11-17 15:46 | 只看該作者
  1. Sub test()
  2. Dim d,d1,m%,n%,i%,j%,Rng, found
  3. Set d = CreateObject("scripting.dictionary")
  4. Set d1 = CreateObject("scripting.dictionary")
  5. Range("c3:f" & Cells(Rows.Count, 3).End(xlUp).Row).Interior.Color = xlNone
  6. For i = 3 To Range("c3").End(xlDown).Row
  7.     d(Cells(i, 3).Value) = ""
  8. Next i
  9. k = d.keys
  10. For i = 0 To UBound(k)
  11.     For j = 3 + n To Range("c3").End(xlDown).Row
  12.         If k(i) = Cells(j, 3) Then
  13.             m = m + 1
  14.             n = n + 1
  15.         Else
  16.             Set Rng = Cells(j - m, 3).Resize(m, 4)
  17.             For Each Cell In Rng.Range(Cells(1, 4), Cells(Rng.Rows.Count, 4))
  18.                 If CDate(Split(Cell.Value, " ")(0)) = Date Then
  19.                     found = True
  20.                     d1(Split(Cell.Value, " ")(0)) = ""
  21.                 Else
  22.                     d1(Split(Cell.Value, " ")(0)) = ""
  23.                 End If
  24.             Next Cell
  25.                 k1 = d1.keys
  26.             Select Case d1.Count
  27.                 Case 1
  28.                     If CDate(k1(0)) = Date Then
  29.                     Rng.Interior.Color = 255
  30.                     End If
  31.                 Case 2
  32.                     If found = True Then
  33.                         For ii = 1 To Rng.Rows.Count
  34.                             If CDate(Split(Rng.Cells(ii, 4), " ")(0)) <> Date Then
  35.                                 Rng.Cells(ii, 1).Resize(1, 4).Interior.Color = 16711935
  36.                             End If
  37.                         Next ii
  38.                     End If
  39.                 Case Else
  40.                     If found = True Then
  41.                         For ii = 1 To Rng.Rows.Count
  42.                             If CDate(Split(Rng.Cells(ii, 4), " ")(0)) = Date Then
  43.                                 Rng.Cells(ii, 1).Resize(1, 4).Interior.Color = 255
  44.                             End If
  45.                         Next ii
  46.                     End If
  47.             End Select
  48.             m = 0
  49.             found = False
  50.             d1.RemoveAll
  51.             Exit For
  52.         End If
  53.     Next j
  54. Next i
  55. If Range("a2") <> "" Then
  56. Set Rng = Range("c3:c" & Cells(Rows.Count, 3).End(xlUp).Row)
  57.     For i = 1 To Rng.Rows.Count
  58.        If Rng.Cells(i) = Range("a2") Then
  59.        Rng.Resize(i, 4).Interior.Color = xlNone
  60.        End If
  61.     Next i
  62. End If
  63. End Sub
複製代碼
回復 1# RCRG

TOP

        靜思自在 : 地上種了菜，就不易長草；心中有善，就不易生惡。
12
返回列表 上一主題