返回列表 上一主題 發帖

[發問] 有 >1組以上的組合時,則標示底色的語法。

[發問] 有 >1組以上的組合時,則標示底色的語法。

本帖最後由 papaya 於 2017-11-8 22:47 編輯

12生肖-VBA.png
2017-11-8 22:44


PS︰
程式碼寫在Sheet1即可;Sheet2和Sheet3只作輔助說明用~完成後即移除。
B2的編號和C2的指定生肖以人工填入。

以D欄=B2編號同列(E︰H)=C2的生肖和J︰M對應區段的同列間隔5欄之生肖(以下簡稱為對應生生肖)為指定組合~
EX︰B2=10;C2=虎,即以G2的虎和L2的龍為指定組合。
EX︰B2=14;C2=牛,即以E6的牛和J6的羊為指定組合。
其餘.......類推

需求︰
E︰H區段有顯示=C2的指定生肖和J︰M對應區段的同列也有顯示對應生肖(不限間隔5欄)>1組(含指定組合)時,
則C2標示黃底色;如上述的 >1組的組合,各標示黃底色(E︰H)和淺粉藍底色(J︰M)。
EX︰Sheet1=>當B2=10;C2=虎時;即是虎(G2)和對應區段的龍(L2)為指定組合;
則有︰
G2=虎*L2=龍;F5=虎*M5=龍;E7=虎*K7=龍等共計3組。
所以將C2,G2, F5,E7各標示黃底色;另將L2, M5, K7各標示淺粉藍底色。

EX︰Sheet2=>當B2=14;C2=牛時;即是牛(E6)和對應區段的羊(J6)為指定組合;
則有︰
E6=牛*J6=羊;F8=牛*M8=羊等共計2組。
所以將C2,E6, F8各標示黃底色;另將J6, M8各標示淺粉藍底色。

EX︰Sheet3=>當B2=12;C2=猴時;即是猴(E4)和對應區段的猴(J4)為指定組合;
則只有︰
E4=猴*J4=猴等共計1組。
所以都不標示任何底色。


請問︰如上述需求的程式語法?
謝謝!


12生肖-VBA.rar (10.92 KB)
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

回復 1# papaya

「格式化條件」解法
格式.gif
2017-11-9 10:51


活頁簿計算,選「自動」(原檔為手動)
2017-11-09_101643.png
2017-11-9 10:52


定義名稱,簡化公式;設定格式化條件
2017-11-09_102958.png
2017-11-9 10:55
*YC的筆記鋪 - Excel、Word教學
http://lyc017.pixnet.net/blog

TOP

(輔助)C3=IF(SUM(MMULT((INDEX(J$2:M$9,MATCH(B2,D:D,)-1,MATCH(C2,OFFSET(E$1:H$1,MATCH(B2,D:D,)-1,),))=J$2:M$8)*1,{1;1;1;1})*MMULT((E$2:H$8=C2)*1,{1;1;1;1}))>1,INDEX(J$2:M$9,MATCH(B2,D:D,)-1,MATCH(C2,OFFSET(E$1:H$1,MATCH(B2,D:D,)-1,),)),"X")

C2格式化=C3<>"X"

E2:H8格式化=(E2=$C$2)*OR($J2:$M2=$C$3)

J2:M8格式化=(J2=$C$3)*OR($E2:$H2=$C$2)
隨意窩 "EXCEL迷"  blog  或 http://blog.xuite.net/hcm19522/twblog
已收集3600篇 EXCEL函數
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 2# joblyc017
J大:
感謝您再次指導^^
不好意思,如果是以格式化條件來標示底色,小弟已經會了。
本題以程式語法作需求,是小弟想研究語法的編寫。

再次謝謝您費神的熱心指導~感恩^^
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 3# hcm19522
h大:
感謝您再次指導^^
不好意思,本題以程式語法作需求,是小弟想研究語法的編寫。

再次謝謝您耗神的熱心指導~感恩^^
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

本帖最後由 Hsieh 於 2017-11-10 12:14 編輯

回復 1# papaya
  1. Private Sub CommandButton1_Click()
  2. Dim MyRng As Range, MyRng1 As Range
  3. k = [B2]
  4. a = [C2]
  5. Set Rng = Columns("D").Find(k, lookat:=xlWhole)
  6. mystr = Join(Application.Transpose(Application.Transpose(Rng.Offset(, 1).Resize(, 4))), "")
  7. s = InStr(mystr, a)
  8. If s = 0 Then MsgBox "此列無此生肖": End
  9. t = Mid(Join(Application.Transpose(Application.Transpose(Rng.Offset(, 6).Resize(, 4))), ""), s, 1)
  10. For Each c In Range([D2], [D2].End(xlDown))
  11.    Set n = c.Offset(, 1).Resize(, 4).Find(a, lookat:=xlWhole)
  12.    Set m = c.Offset(, 6).Resize(, 4).Find(t, lookat:=xlWhole)
  13.    If Not n Is Nothing And Not m Is Nothing Then
  14.       cnt = cnt + 1
  15.       If MyRng Is Nothing Then
  16.       Set MyRng = n
  17.       Set MyRng1 = m
  18.       Else
  19.       Set MyRng = Union(MyRng, n)
  20.       Set MyRng1 = Union(MyRng1, m)
  21.       End If
  22.    End If
  23. Next
  24. MsgBox cnt & "次"
  25. If cnt > 1 Then
  26.   MyRng.Interior.ColorIndex = 6
  27.   MyRng1.Interior.ColorIndex = 8
  28. End If
  29. End Sub
複製代碼
學海無涯_不恥下問
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 6# Hsieh
H超級版主:
感謝您的再次指導^^

貴解答比小弟的需求設想還周全。
小弟會仔細研習的~感恩^^
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

        靜思自在 : 君子如水,隨方就圓,無處不自在。
返回列表 上一主題