- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-11-7 10:34 ½s¿è
¦^´_ 7# ã´£³¡ªL
ÁÂÁ«e½ú«ü¾É
«á¾Çªì¨B»{ÃÑFunction ¦Ûq¸q¨ç¼Æ,ì¨Ó¥¦¥i¥H¥Î¦bVBAµ{¦¡½X¸Ì,¤]¥i¥H·íÀx¦s®æ¤½¦¡ªº¨ç¼Æ
¥H¤U¾Ç²ß¤ß±oµù¸Ñ½Ð«e½ú¦A«ü¾É!
Function GetRangeColor(xA As Range, xArea As Range, xType%)
'¡ôFunction()¨ç¼Æ µ{¦¡¬O¤@¨t¦Cªº Visual Basic »y¥y¡A¥Ñ Function ©M End ¨ç¼Æ »y¥y©Ò¬A¦í¡C
'¨ç¼Æ µ{¦¡»P °Æµ{¦¡ Ãþ¦ü¡A¦ý¨ç¼Æ¤]¥i¥H¶Ç¦^È¡C
'(xA As Range, xArea As Range, xType%)=(ÃC¦â®æ,¸ê®Æ°Ï°ì,pºâ¼Ò¦¡)
'¥H¤U¥H[E3]¬°¨Ò: =GetRangeColor($D3,$A$1:$A$25,E$1)
'ÃC¦â®æ(xA):$D3 >>«ü©w[D3]Àx¦s®æ!¬O¦]¬°³]pªÌ¦b«á¤èµ{§Ç·|§PŪ¦¹®æ©³¦â (¶À¦â)
'ª`·Nªº¬O:¤£¬O¦]¬°[D3]Àx¦s®æ¸Ì¦³ "¶À" ³oÓ¦r! ¬Oµ{¦¡§PŪ¦¹®æ©³¦â¬O¶À¦â
'¸ê®Æ°Ï°ì(xArea):$A$1:$A$25 >>«ü©w³oÓ°Ï°ìÀx¦s®æ!¬O¦]¬°³]pªÌ¦b«á¤èµ{¦¡¸Ì
',§PŪþ´X®æªº©³¦â¸ò[D3]ªº©³¦â¤@¼Ë§@¬°±ø¥ó
'pºâ¼Ò¦¡(xType):E$1 >>«ü©w³]pªÌ²Îpªºþ¤@ÓÈ!³]pªÌ¦b«á¤èµ{¦¡¸Ì²Îp¤F
'¦Xp Ó¼Æ ¥§¡È ³Ì¤jÈ ³Ì¤pÈ >>¨Ï¥ÎªÌ¥i¥H¥Ñ 1~5 «ü©w
'¤]¥i¥Hª½±µ¿é¤J1 =GetRangeColor($D3,$A$1:$A$25,1)
'¬°¤°»ò¤£ª½±µ¿é¤J 1? ¦]¬°¦pªG¨ä¥¦Àx¦s®æ¤]¥Î[E1]·íÅܼÆ!§â[E1]§ï2 ´N·|¤@°_ÅÜ!¤£¥²¤@¤@§ï
'µ²½×:§PŪ $A$1:$A$25 Àx¦s®æ¸Ì,¦pªG©³¦â¬O¶À¦â,´N¦b [E3]Àx¦s®æ Åã¥Ü ¦Xp È
Dim xR As Range, X, S(5), C&
'¡ô«Å§iÅܼÆ,S(5)¬O§å¦¸«Å§i±qS(0)~S(5) ¦@¤»Ó
Application.Volatile
'¡ô±N¨Ï¥ÎªÌ©w¸qªº¨ç¼Æ¼Ð¥Ü¬°©öÅÜ¡C
'¨C·í¤u§@ªí¤W¥ô¦óÀx¦s®æµo¥Ípºâ®É¡A³£¥²¶·«·spºâ©öÅܨç¼Æ¡C
X = xA.Interior.ColorIndex
'¡ô¥H[E3]¬°¨Ò:¦¹³B¤w¸gµ¹ GetRangeColor¨ç¼Æ²Ä¤@ÓÈ 6(¶À¦â)
For Each xR In xArea
'¡ô³]¶¶°j°é! ¥OxR¬O ¸ê®Æ°Ï°ì(xArea)¸Ìªº¤@û
If xR.Interior.ColorIndex = X Then
'¡ô¥H[E3]¬°¨Ò:¦pªG[A1]¬OX(¶À¦â) ?? [A1]¬O¶À©³!Àx¦s®æȬO 51
S(0) = Val(xR.Value)
'¡ô¥H[E3]¬°¨Ò:´NÅý²Ä¤@ÓSÅܼƬO [A1]ªº¹BºâÈ 51
S(1) = S(1) + S(0) '¦Xp
'¡ô¥H[E3]¬°¨Ò:Åý²Ä¤GÓSÅܼƲ֥[ ²Ä¤@ÓSÅܼÆ0+51=51
S(2) = S(2) + 1 'Ó¼Æ
'¡ô¥H[E3]¬°¨Ò:Åý²Ä¤TÓSÅܼƲ֥[ 0+1 = 1
If S(2) > 0 Then S(3) = S(1) / S(2) '¥§¡È
'¡ô¦pªG²Ä¤TÓSÅܼƤj©ó 0 ??´NÅý²Ä¥|ÓSÅܼÆ= ²Ä¤@ÓSÅܼÆ/²Ä¤GÓSÅܼÆ
'¡ô¥H[E3]¬°¨Ò:(51/1)=51
'¦]¬°¦pªG°£¦¡ªº¤À¥À¬O 0 °£¦¡ªº°ÓȬOµL¤j!³on¦h¤@ÓIf §PÂ_¦¡Á×±¼!
If S(0) > S(4) Then S(4) = S(0) '³Ì¤jÈ
'¡ô¦pªG²Ä¤@ÓSÅܼƤj©ó ²Ä¤ÓSÅܼÆ! ´N²Ä¤ÓSÅܼƴN´«¸Ë²Ä¤@ÓSÅܼÆ
If S(5) = Empty Or S(0) < S(5) Then S(5) = S(0) '³Ì¤pÈ
'¡ô¦pªG²Ä¤»ÓSÅܼƬOªì©lÈ©Î ²Ä¤@ÓSÅܼƤp©ó ²Ä¤»ÓSÅܼÆ!
'´N²Ä¤»ÓSÅܼƴN´«¸Ë²Ä¤@ÓSÅܼÆ
End If
Next
GetRangeColor = S(xType)
'¡ô¨Ï¥Î GetRangeColor ³oÓ¦Ûq¸q¨ç¼Æ!
'±ø¥ó§¹¾ã!´NÅýÀx¦s®æ©Î°Æµ{¦¡pºâÈ!§_«h´N¸Ó°»¿ùÅo!
'¦pªGIJµo¥\¯à¬O¥¢®Ä¼Ò¦¡ Application.EnableEvents = False,
'GetRangeColor¨ç¼Æ¤]·|¥¢®Ä!¦³¥¢¯uªººÃ¼{!©Ò¥H¥Î©óÀx¦s®æ¤½¦¡¸Ì®É!nª`·N!
End Function
Sub TTT()
Dim C As Range, AR As Range, T%
Set C = [SHEET1!D3]: Set AR = [SHEET1!A1:A25]: T = 1
MsgBox "[E3]Àx¦s®æ²Îp[A1:A25]¶À©³®æ¦XpÈ" & GetRangeColor(C, AR, T)
End Sub
|
|