返回列表 上一主題 發帖

EXCEL ActiveX控制按鈕 請教

EXCEL ActiveX控制按鈕 請教

請問各位高手,我EXCEL內有一個VBA功能是可以依照儲存格顏色自動計算總和,但是只要更動了一個數值,就會自動更新,這樣當我資料越來越多整個電腦速度就會被拖慢,是否可以將此功能寫入ActiveX控制按鈕中,當我有需要時再全部更新呢?
1676535485540.jpg
2023-2-17 11:34

本帖最後由 Andy2483 於 2023-2-17 15:33 編輯

回復 1# sschristy

謝謝前輩發表此主題
後學學習的建議方案範例如下:

1.開一個新活頁簿
2.把下列程式碼植入VBA模組中做測試
2.1.先執行亂數重設>>產生資料
2.2.再執行兩種合計

Option Explicit
Sub E欄同底色合計_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欄同底色合計_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

亂數重設:
Q.JPG
2023-2-17 15:06


合計結果:
A.jpg
2023-2-17 15:06
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 2# Andy2483


    感謝回復,但跟我想要的效果似乎不太一樣,我是在EXCEL一般區內"有顏色儲存格數字加總",看到准提部林大大所教的VBA自訂函數,正好可以用在工作上,
但是我實際的資料量很大,每改一次數字,函數就會自動計算,因此想要詢問是否可以讓此函數只在我想要的時候再運算。例如加上一個控制按鈕,按下後就會更新。

TOP

本帖最後由 Andy2483 於 2023-2-18 08:28 編輯

回復 3# sschristy


    謝謝前輩回復
http://forum.twbts.com/thread-23804-1-2.html
今天再研究過這帖,經測試心得建議前輩如下方法做測試,或許就可以減少重算次數
1.'Application.Volatile,在這行前面加單引號,變成註解,會變成只有統計資料範圍的儲存格被編輯成不同數值才會重算
2.Application.Volatile 方法的知識查詢網頁:
https://learn.microsoft.com/zh-t ... pplication.volatile
3.但是此方法有一個缺點:如果統計資料範圍的儲存格只有被變儲存格底色! 資料不會被重算,
只有統計資料範圍的儲存格被編輯成不同數值才會重算

以上都只是情境猜測,如果可以上傳範例供研究可以更明確
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 4# Andy2483

感謝回覆,上傳附件供參考,因為資料數量龐大,如果每更改一次就運算一次自訂函數,電腦會變很慢,所以想要做一個按鈕,按了之後再一起計算






依顏色統計數量.zip (137.74 KB)

TOP

本帖最後由 Andy2483 於 2023-2-18 13:41 編輯

回復 5# sschristy


    謝謝前輩回復提供範例
後學建議方案是以工作表切換才重算,不必增設按鈕:

1.在顏色分類 工作表模組植入以下程式碼:
Private Sub Worksheet_Activate()
[統計表!G1] = 0
End Sub

2.在統計表 工作表模組植入以下程式碼:
Private Sub Worksheet_Activate()
[統計表!G1] = 1
End Sub

3.將下列藍字添加
Function GetRangeColor(xA As Range, xArea As Range, xType%)
Dim xR As Range, X, S(5), C&
'Application.Volatile
If [統計表!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) '合計
       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) '最大值
       If S(5) = Empty Or S(0) < S(5) Then S(5) = S(0) '最小值
    End If
Next
GetRangeColor = S(xType)
End Function

4.兩個工作表切換看看,顏色分類 工作表輸入新數字測試看看

2023-02-18_132213.JPG
2023-2-18 13:26


2023-02-18_132303.JPG
2023-2-18 13:26
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 6# Andy2483


    感謝提供另外的想法,但還是想知道是否可以用按鈕來執行?

TOP

本帖最後由 Andy2483 於 2023-2-18 15:27 編輯

回復 7# sschristy


    謝謝前輩再回復
按鈕方式:
2023-02-18_150050.JPG
2023-2-18 15:02


Sub 重算()
[統計表!G1:H1] = 0
[統計表!G1] = 1
[統計表!H1] = 1
End Sub

Function GetRangeColor(xA As Range, xArea As Range, xType%)
Dim xR As Range, X, S(5), C&
'Application.Volatile
If [統計表!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) '合計
       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) '最大值
       If S(5) = Empty Or S(0) < S(5) Then S(5) = S(0) '最小值
    End If
Next
GetRangeColor = S(xType)
End Function
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 Andy2483 於 2023-2-20 10:23 編輯

回復 7# sschristy


    謝謝前輩
後學學習陣列與字典的另一方案,請前輩試試看,謝謝

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("統計表")
   .[A1:F10].Copy .[A11]
   .[B13].Resize(8, 4) = Arr
   Application.Goto .[A1]
End With
Set Y = Nothing
Erase Arr
End Sub

2023-02-20_102219.JPG
2023-2-20 10:22
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 9# Andy2483


    感謝指導

TOP

        靜思自在 : 受人點水之恩,須當湧泉以報。
返回列表 上一主題