麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 某個範圍內依據條件填上顏色 [打印本頁]

作者: maiko 時間: 2022-10-7 17:52 標題: 某個範圍內依據條件填上顏色

[attach]35279[/attach]

[attach]35280[/attach]

作者: Andy2483 時間: 2022-10-8 13:04

本帖最後由 Andy2483 於 2022-10-8 13:06 編輯

回復 1# maiko

謝謝前輩發表此主題與範例
請前輩試看看
今天習得
WorksheetFunction.Max()
CDate()
Format(date, "dddd")
Union()
練習陣列與字典

原始:
[attach]35283[/attach]

結果:
[attach]35282[/attach]

Option Explicit
Sub 搜尋變色()
Dim xA, Arr, Ra As Range, i&, x&, T, Ts, T1, T2, Tn
Dim xD, Rng As Range, Ct
'↑宣告變數

Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典

Set xA = [A1].CurrentRegion.Offset(1, 0)
'↑將xA儲存格設為 ([A1]相鄰非空格所串連起來的儲存格,
'擴展到方正區域的最小範圍,
'往下偏移一列 )

Arr = [I1].CurrentRegion.Offset(1, 0)
'↑將 ([I1]相鄰非空格所串連起來的儲存格,
'擴展到方正區域的最小範圍,
'往下偏移一列 ),
'倒入Arr陣列中

Arr(UBound(Arr), 1) = CDate(WorksheetFunction.Max(xA))
'↑令Arr陣列的最左下角那格是xA儲存格裡的最大值
'並轉換為日期 YYYY/M/D 在陣列中呈現

For i = 1 To UBound(Arr) - 1
'↑設定迴圈將Arr這些被搜尋的日期範圍與J.K欄關鍵字組成字串當KEY
'倒入xD陣列中,ITEM設為6(ITEM設>0的數字就可以!因為ITEM沒有用到)

Ts = Arr(i, 1)
Tn = Arr(i + 1, 1)
T1 = Arr(i, 2)
T2 = Arr(i, 3)
T = Tn - Ts
For x = 0 To T
   xD(Ts + x & T1) = 6
   xD(Ts + x & T2) = 6
Next
Next
For Each Ra In xA
'↑設定迴圈將xA裡的儲存格組成字串,
'(YYYY/M/D&Weekday)之後
'到xD字典裡查看看是否查得到,
'如果有就把儲存格放入Rng儲存格集裡

Ct = Ra & Format(Ra, "dddd")
If xD(Ct) Then
   If Rng Is Nothing Then
      Set Rng = Ra
      Else
         Set Rng = Union(Rng, Ra)
   End If
End If
Next
Rng.Interior.ColorIndex = 38
'↑最後把儲存格集的底色變更為想要的顏色

End Sub

作者: hcm19522 時間: 2022-10-8 15:41

https://blog.xuite.net/hcm19522/twblog/590574845

作者: maiko 時間: 2022-10-9 06:02

hcm19522 發表於 2022-10-8 15:41

感謝幫助！

作者: maiko 時間: 2022-10-9 06:05

回復 maiko

謝謝前輩發表此主題與範例
請前輩試看看
今天習得
WorksheetFunction.Max()
CDa ...
Andy2483 發表於 2022-10-8 13:04

你好，在2022-02-07這個星期應該是 Tuesday Wednesday 這兩天的，但是2022-02-07 Monday也填上顏色，有這麼的小小錯誤。
不過還是感謝你的幫助！

作者: Andy2483 時間: 2022-10-9 08:51

回復 5# maiko
謝謝前輩指導
後學只一股腦練習技巧
後學沒做好驗證的程序
謝謝前輩幫忙做了驗證
謝謝

作者: hcm19522 時間: 2022-10-9 16:27

回復 4# maiko

另解=(VLOOKUP($A2,$I:$K,2,1)=A$1)+(VLOOKUP($A2,$I:$K,3,1)=A$1)

作者: Andy2483 時間: 2022-10-11 09:04

你好，在2022-02-07這個星期應該是 Tuesday Wednesday 這兩天的，但是2022-02-07 Monday也填上顏 ...
maiko 發表於 2022-10-9 06:05

謝謝前輩指正
後學檢討修正與檢測如下:
原始工作表1 有上色的儲存格畫面:
[attach]35288[/attach]

另複製一份工作表命名為工作表N 全無底色:
[attach]35289[/attach]

執行程式碼後即並排做比較:
[attach]35290[/attach]

滾動滑鼠做比較2:
[attach]35291[/attach]

滾動滑鼠做比較3:
[attach]35292[/attach]

滾動滑鼠做比較4:
[attach]35293[/attach]

謝謝前輩指導!
再有錯也請再指導!

作者: Andy2483 時間: 2022-10-11 09:11

回復 5# maiko

今天習得同檔案,不同工作表!開心視窗並排目視比較
心得如下:

Option Explicit
Sub 搜尋變色()
Dim xA, Arr, Ra As Range, i&, x&, T, Ts, T1, T2, Tn
Dim xD, Rng As Range, Ct, Awn
'↑宣告變數

Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典

Set xA = Sheets("工作表N").[A1].CurrentRegion.Offset(1, 0)
'↑將xA儲存格設為 ([A1]相鄰非空格所串連起來的儲存格,
'擴展到方正區域的最小範圍,
'往下偏移一列 )

Arr = [I1].CurrentRegion.Offset(1, 0)
'↑將 ([I1]相鄰非空格所串連起來的儲存格,
'擴展到方正區域的最小範圍,
'往下偏移一列 ),
'倒入Arr陣列中

Arr(UBound(Arr), 1) = CDate(WorksheetFunction.Max(xA) + 1)
'↑令Arr陣列的最左下角那格是xA儲存格裡的最大值
'並轉換為日期 YYYY/M/D 在陣列中呈現

'↑這裡是犯錯的地方!需要再加1,才能涵蓋xA範圍裡的最大日期

For i = 1 To UBound(Arr) - 1
'↑設定迴圈將Arr這些被搜尋的日期範圍與J.K欄關鍵字組成字串當KEY
'倒入xD陣列中,ITEM設為6(ITEM設>0的數字就可以!因為ITEM沒有用到)

Ts = Arr(i, 1)
Tn = Arr(i + 1, 1)
T1 = Arr(i, 2)
T2 = Arr(i, 3)
T = Tn - Ts - 1
   '↑這裡也是犯錯的地方!少減了1

For x = 0 To T
   xD(Ts + x & T1) = 0.1
   xD(Ts + x & T2) = 0.1
Next
Next
For Each Ra In xA
'↑設定迴圈將xA裡的儲存格組成字串,
'(YYYY/M/D&Weekday)之後
'到xD字典裡查看看是否查得到,
'如果有就把儲存格放入Rng儲存格集裡

Ct = Ra & Format(Ra, "dddd")
If xD(Ct) Then
   If Rng Is Nothing Then
      Set Rng = Ra
      Else
         Set Rng = Union(Rng, Ra)
   End If
End If
Next
xA.Interior.ColorIndex = xlNone
'↑把A:G欄的色全部變為無底色

Rng.Interior.ColorIndex = 38
'↑最後把儲存格集的底色變更為想要的顏色

Awn = ActiveWorkbook.Name
'↑令Awn是本檔的檔名

ActiveWindow.NewWindow
'↑將本檔再開另一個視窗

Sheets("工作表1").Activate
'↑這視窗顯示在 "工作表1" 工作表上

Windows.CompareSideBySideWith Awn & ":1"
'↑讓兩個視窗並排比較

Windows.SyncScrollingSideBySide = True
'↑讓兩個視窗同時滾動做比較

End Sub

作者: maiko 時間: 2022-10-17 11:39

回復 maiko

今天習得同檔案,不同工作表!開心視窗並排目視比較
心得如下:

Option Explicit
...
Andy2483 發表於 2022-10-11 09:11

感謝幫助，學到很多東西！

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