Board logo

標題: [發問] 有 >1組以上的組合時，則標示底色的語法。 [打印本頁]
作者: papaya    時間: 2017-11-8 22:46     標題: 有 >1組以上的組合時，則標示底色的語法。

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

[attach]27936[/attach]

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組。
所以都不標示任何底色。


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

[attach]27937[/attach]
作者: joblyc017    時間: 2017-11-9 10:57

回復 1# papaya

「格式化條件」解法
[attach]27941[/attach]

活頁簿計算，選「自動」（原檔為手動）
[attach]27942[/attach]

定義名稱，簡化公式；設定格式化條件
[attach]27944[/attach]
作者: hcm19522    時間: 2017-11-9 11:37

(輔助)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)
作者: papaya    時間: 2017-11-9 11:43

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

再次謝謝您費神的熱心指導~感恩^^
作者: papaya    時間: 2017-11-9 11:54

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

再次謝謝您耗神的熱心指導~感恩^^
作者: Hsieh    時間: 2017-11-9 14:32

本帖最後由 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
複製代碼
作者: papaya    時間: 2017-11-9 15:18

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

貴解答比小弟的需求設想還周全。
小弟會仔細研習的~感恩^^



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