papaya

帖子: 323
主題: 79
精華: 0
積分: 407
點名: 0
作業系統: win7
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-10-22
最後登錄: 2022-1-18

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2017-11-8 22:46 | 只看該作者

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

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

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)

樓主熱帖

papaya

中學生 Rank: 2

帖子: 323
主題: 79
精華: 0
積分: 407
點名: 0
作業系統: win7
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-10-22
最後登錄: 2022-1-18

7^#

發表於 2017-11-9 15:18 | 只看該作者

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

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 134
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-6-2

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2017-11-9 14:32 | 只看該作者

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

回復 1# papaya

Private Sub CommandButton1_Click()
Dim MyRng As Range, MyRng1 As Range
k = [B2]
a = [C2]
Set Rng = Columns("D").Find(k, lookat:=xlWhole)
mystr = Join(Application.Transpose(Application.Transpose(Rng.Offset(, 1).Resize(, 4))), "")
s = InStr(mystr, a)
If s = 0 Then MsgBox "此列無此生肖": End
t = Mid(Join(Application.Transpose(Application.Transpose(Rng.Offset(, 6).Resize(, 4))), ""), s, 1)
For Each c In Range([D2], [D2].End(xlDown))
Set n = c.Offset(, 1).Resize(, 4).Find(a, lookat:=xlWhole)
Set m = c.Offset(, 6).Resize(, 4).Find(t, lookat:=xlWhole)
If Not n Is Nothing And Not m Is Nothing Then
cnt = cnt + 1
If MyRng Is Nothing Then
Set MyRng = n
Set MyRng1 = m
Else
Set MyRng = Union(MyRng, n)
Set MyRng1 = Union(MyRng1, m)
End If
End If
Next
MsgBox cnt & "次"
If cnt > 1 Then
MyRng.Interior.ColorIndex = 6
MyRng1.Interior.ColorIndex = 8
End If
End Sub

複製代碼

學海無涯_不恥下問

TOP

papaya

中學生 Rank: 2

帖子: 323
主題: 79
精華: 0
積分: 407
點名: 0
作業系統: win7
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-10-22
最後登錄: 2022-1-18

5^#

發表於 2017-11-9 11:54 | 只看該作者

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

再次謝謝您耗神的熱心指導~感恩^^

TOP

papaya

中學生 Rank: 2

帖子: 323
主題: 79
精華: 0
積分: 407
點名: 0
作業系統: win7
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-10-22
最後登錄: 2022-1-18

4^#

發表於 2017-11-9 11:43 | 只看該作者

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

再次謝謝您費神的熱心指導~感恩^^

TOP

hcm19522

大學生 Rank: 4

帖子: 1412
主題: 4
精華: 0
積分: 1422
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2025-6-2

熱烈參與勳章

3^#

發表於 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)

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

TOP

joblyc017