EXCEL ActiveX±±¨î«ö¶s ½Ð±Ð
- ©«¤l
- 25
- ¥DÃD
- 3
- ºëµØ
- 0
- ¿n¤À
- 51
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 11 ±M·~ª©
- ³nÅ骩¥»
- OFFICE 365
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2023-2-14
- ³Ì«áµn¿ý
- 2023-12-26
|
EXCEL ActiveX±±¨î«ö¶s ½Ð±Ð
½Ð°Ý¦U¦ì°ª¤â¡A§ÚEXCEL¤º¦³¤@ÓVBA¥\¯à¬O¥i¥H¨Ì·ÓÀx¦s®æÃC¦â¦Û°ÊpºâÁ`©M¡A¦ý¬O¥un§ó°Ê¤F¤@Ó¼ÆÈ¡A´N·|¦Û°Ê§ó·s¡A³o¼Ë·í§Ú¸ê®Æ¶V¨Ó¶V¦h¾ãÓ¹q¸£³t«×´N·|³Q©ìºC¡A¬O§_¥i¥H±N¦¹¥\¯à¼g¤JActiveX±±¨î«ö¶s¤¤¡A·í§Ú¦³»Ýn®É¦A¥þ³¡§ó·s©O¡H
|
|
|
|
|
|
|
- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-2-17 15:33 ½s¿è
¦^´_ 1# sschristy
ÁÂÁ«e½úµoªí¦¹¥DÃD
«á¾Ç¾Ç²ßªº«Øij¤è®×½d¨Ò¦p¤U:
1.¶}¤@Ó·s¬¡¶Ã¯
2.§â¤U¦Cµ{¦¡½X´Ó¤JVBA¼Ò²Õ¤¤°µ´ú¸Õ
2.1.¥ý°õ¦æ¶Ã¼Æ«³]>>²£¥Í¸ê®Æ
2.2.¦A°õ¦æ¨âºØ¦Xp
Option Explicit
Sub EÄæ¦P©³¦â¦Xp_1()
Application.EnableEvents = False
Dim i&, C3&, C17&, T, C&
T = Timer
For i = 1 To Cells(Rows.Count, "E").End(3).Row
C = Cells(i, "E").Interior.ColorIndex
If C = 3 Then C3 = C3 + Val(Cells(i, "E"))
If C = 17 Then C17 = C17 + Val(Cells(i, "E"))
Next
[B1] = C3: [A1].Interior.ColorIndex = 3
[B2] = C17: [A2].Interior.ColorIndex = 17
Application.EnableEvents = True
MsgBox Format(Timer - T, "0.00’")
End Sub
Sub EÄæ¦P©³¦â¦Xp_2()
Application.EnableEvents = False
Dim i&, C&, Y, Arr, T
T = Timer
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([E1], Cells(Rows.Count, "E").End(3))
For i = 1 To UBound(Arr)
C = Cells(i, "E").Interior.ColorIndex
Y(C) = Y(C) + Val(Arr(i, 1))
Next
[B1] = Y(3): [A1].Interior.ColorIndex = 3
[B2] = Y(17): [A2].Interior.ColorIndex = 17
Application.EnableEvents = True
MsgBox Format(Timer - T, "0.00’")
End Sub
Sub ¶Ã¼Æ«³]()
Dim xArea, xR, R
Set xArea = [E1:E10000]
With xArea
.Value = "=INT(RAND()*100)"
.Value = .Value
.Interior.ColorIndex = 17
End With
For Each xR In xArea
If Int(Rnd() * 100) Mod 2 Then xR.Interior.ColorIndex = 3
Next
[B1:B2] = ""
End Sub
¶Ã¼Æ«³]:
¦Xpµ²ªG:
|
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 25
- ¥DÃD
- 3
- ºëµØ
- 0
- ¿n¤À
- 51
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 11 ±M·~ª©
- ³nÅ骩¥»
- OFFICE 365
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2023-2-14
- ³Ì«áµn¿ý
- 2023-12-26
|
¦^´_ 2# Andy2483
·PÁ¦^´_¡A¦ý¸ò§Ú·Qnªº®ÄªG¦ü¥G¤£¤Ó¤@¼Ë¡A§Ú¬O¦bEXCEL¤@¯ë°Ï¤º"¦³ÃC¦âÀx¦s®æ¼Æ¦r¥[Á`"¡A¬Ý¨ìã´£³¡ªL¤j¤j©Ò±ÐªºVBA¦Ûq¨ç¼Æ¡A¥¿¦n¥i¥H¥Î¦b¤u§@¤W¡A
¦ý¬O§Ú¹ê»Úªº¸ê®Æ¶q«Ü¤j¡A¨C§ï¤@¦¸¼Æ¦r¡A¨ç¼Æ´N·|¦Û°Êpºâ¡A¦]¦¹·Qn¸ß°Ý¬O§_¥i¥HÅý¦¹¨ç¼Æ¥u¦b§Ú·Qnªº®ÉÔ¦A¹Bºâ¡C¨Ò¦p¥[¤W¤@Ó±±¨î«ö¶s¡A«ö¤U«á´N·|§ó·s¡C |
|
|
|
|
|
|
- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-2-18 08:28 ½s¿è
¦^´_ 3# sschristy
ÁÂÁ«e½ú¦^´_
http://forum.twbts.com/thread-23804-1-2.html
¤µ¤Ñ¦A¬ã¨s¹L³o©«,¸g´ú¸Õ¤ß±o«Øij«e½ú¦p¤U¤èªk°µ´ú¸Õ,©Î³\´N¥i¥H´î¤Ö«ºâ¦¸¼Æ
1.'Application.Volatile,¦b³o¦æ«e±¥[³æ¤Þ¸¹,Åܦ¨µù¸Ñ,·|Åܦ¨¥u¦³²Îp¸ê®Æ½d³òªºÀx¦s®æ³Q½s¿è¦¨¤£¦P¼ÆȤ~·|«ºâ
2.Application.Volatile ¤èªkªºª¾ÃѬd¸ßºô¶:
https://learn.microsoft.com/zh-t ... pplication.volatile
3.¦ý¬O¦¹¤èªk¦³¤@Ó¯ÊÂI:¦pªG²Îp¸ê®Æ½d³òªºÀx¦s®æ¥u¦³³QÅÜÀx¦s®æ©³¦â! ¸ê®Æ¤£·|³Q«ºâ,
¥u¦³²Îp¸ê®Æ½d³òªºÀx¦s®æ³Q½s¿è¦¨¤£¦P¼ÆȤ~·|«ºâ
¥H¤W³£¥u¬O±¡¹Ò²q´ú,¦pªG¥i¥H¤W¶Ç½d¨Ò¨Ñ¬ã¨s¥i¥H§ó©ú½T |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 25
- ¥DÃD
- 3
- ºëµØ
- 0
- ¿n¤À
- 51
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 11 ±M·~ª©
- ³nÅ骩¥»
- OFFICE 365
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2023-2-14
- ³Ì«áµn¿ý
- 2023-12-26
|
¦^´_ 4# Andy2483
·PÁ¦^ÂСA¤W¶Çªþ¥ó¨Ñ°Ñ¦Ò¡A¦]¬°¸ê®Æ¼Æ¶qÃe¤j¡A¦pªG¨C§ó§ï¤@¦¸´N¹Bºâ¤@¦¸¦Ûq¨ç¼Æ¡A¹q¸£·|ÅܫܺC¡A©Ò¥H·Qn°µ¤@Ó«ö¶s¡A«ö¤F¤§«á¦A¤@°_pºâ
¨ÌÃC¦â²Îp¼Æ¶q.zip (137.74 KB)
|
|
|
|
|
|
|
- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-2-18 13:41 ½s¿è
¦^´_ 5# sschristy
ÁÂÁ«e½ú¦^´_´£¨Ñ½d¨Ò
«á¾Ç«Øij¤è®×¬O¥H¤u§@ªí¤Á´«¤~«ºâ,¤£¥²¼W³]«ö¶s:
1.¦bÃC¦â¤ÀÃþ ¤u§@ªí¼Ò²Õ´Ó¤J¥H¤Uµ{¦¡½X:
Private Sub Worksheet_Activate()
[²Îpªí!G1] = 0
End Sub
2.¦b²Îpªí ¤u§@ªí¼Ò²Õ´Ó¤J¥H¤Uµ{¦¡½X:
Private Sub Worksheet_Activate()
[²Îpªí!G1] = 1
End Sub
3.±N¤U¦CÂŦr²K¥[
Function GetRangeColor(xA As Range, xArea As Range, xType%)
Dim xR As Range, X, S(5), C&
'Application.Volatile
If [²Îpªí!G1] = 0 Then Exit Function
X = xA.Interior.ColorIndex
For Each xR In xArea
If xR.Interior.ColorIndex = X Then
S(0) = Val(xR.Value)
S(1) = S(1) + S(0) '¦Xp
S(2) = S(2) + 1 'Ó¼Æ
If S(2) > 0 Then S(3) = S(1) / S(2) '¥§¡È
If S(0) > S(4) Then S(4) = S(0) '³Ì¤jÈ
If S(5) = Empty Or S(0) < S(5) Then S(5) = S(0) '³Ì¤pÈ
End If
Next
GetRangeColor = S(xType)
End Function
4.¨âÓ¤u§@ªí¤Á´«¬Ý¬Ý,ÃC¦â¤ÀÃþ ¤u§@ªí¿é¤J·s¼Æ¦r´ú¸Õ¬Ý¬Ý
|
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 25
- ¥DÃD
- 3
- ºëµØ
- 0
- ¿n¤À
- 51
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 11 ±M·~ª©
- ³nÅ骩¥»
- OFFICE 365
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2023-2-14
- ³Ì«áµn¿ý
- 2023-12-26
|
¦^´_ 6# Andy2483
·PÁ´£¨Ñ¥t¥~ªº·Qªk¡A¦ýÁÙ¬O·Qª¾¹D¬O§_¥i¥H¥Î«ö¶s¨Ó°õ¦æ¡H |
|
|
|
|
|
|
- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-2-18 15:27 ½s¿è
¦^´_ 7# sschristy
ÁÂÁ«e½ú¦A¦^´_
«ö¶s¤è¦¡:
Sub «ºâ()
[²Îpªí!G1:H1] = 0
[²Îpªí!G1] = 1
[²Îpªí!H1] = 1
End Sub
Function GetRangeColor(xA As Range, xArea As Range, xType%)
Dim xR As Range, X, S(5), C&
'Application.Volatile
If [²Îpªí!H1] = 1 Then Exit Function
X = xA.Interior.ColorIndex
For Each xR In xArea
If xR.Interior.ColorIndex = X Then
S(0) = Val(xR.Value)
S(1) = S(1) + S(0) '¦Xp
S(2) = S(2) + 1 'Ó¼Æ
If S(2) > 0 Then S(3) = S(1) / S(2) '¥§¡È
If S(0) > S(4) Then S(4) = S(0) '³Ì¤jÈ
If S(5) = Empty Or S(0) < S(5) Then S(5) = S(0) '³Ì¤pÈ
End If
Next
GetRangeColor = S(xType)
End Function |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-2-20 10:23 ½s¿è
¦^´_ 7# sschristy
ÁÂÁ«e½ú
«á¾Ç¾Ç²ß°}¦C»P¦r¨åªº¥t¤@¤è®×,½Ð«e½ú¸Õ¸Õ¬Ý,ÁÂÁÂ
Option Explicit
Sub «ºâ2()
Dim xR As Range, xU, Y, Arr(1 To 8, 1 To 4), N&, C#, R&
Set Y = CreateObject("Scripting.Dictionary")
For Each xU In Split("6/47/44/48/46/23/NA/50", "/")
N = N + 1: Y(xU) = N
Next
For Each xU In Array(Range("A°Ï"), Range("B°Ï"), Range("C°Ï"), Range("D°Ï"))
C = C + 1
For Each xR In xU
R = xR.Interior.ColorIndex
If Y.Exists(R & "") = Empty Then GoTo 111
Arr(Y(R & ""), C) = Arr(Y(R & ""), C) + xR.Value
111
Next
Next
With Sheets("²Îpªí")
.[A1:F10].Copy .[A11]
.[B13].Resize(8, 4) = Arr
Application.Goto .[A1]
End With
Set Y = Nothing
Erase Arr
End Sub
|
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 25
- ¥DÃD
- 3
- ºëµØ
- 0
- ¿n¤À
- 51
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 11 ±M·~ª©
- ³nÅ骩¥»
- OFFICE 365
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2023-2-14
- ³Ì«áµn¿ý
- 2023-12-26
|
¦^´_ 9# Andy2483
·PÁ«ü¾É |
|
|
|
|
|
|