c_c_lai

回復 20# c_c_lai
20# 的 Ex() 內之 C、D 欄一行一行地去遞增是為了要
觀察資料處理及過程。以下為改以 "字典" 處裡：

1. Sub ex2()
   
2.     Dim dic As Object, dic2 As Object
   
3.     Dim A As Range, Rng As Range
   
4.    
   
5.     Set dic = CreateObject("Scripting.Dictionary")
   
6.     Set dic2 = CreateObject("Scripting.Dictionary")
   
7.     dic("連續數量") = "數量"
   
8.     dic2("連續位址") = "組合數量"
   
9.    
   
10.     With 工作表1
    
11.         Set Rng = .Range("A1").CurrentRegion
    
12.         Rng.Replace 0, Empty, xlWhole
    
13.         
    
14.         Set A = Rng.Find(Empty)
    
15.         
    
16.         Do Until A Is Nothing
    
17.             A = 0: s = 1
    
18.             Cnt A
    
19.             dic(s) = dic(s) + 1
    
20.             dic2(sRng) = Range(sRng).Count
    
21.             
    
22.             Set A = Rng.Find(Empty)
    
23.         Loop
    
24.     End With
    
25.    
    
26.     With 工作表2
    
27.         .[A1].Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    
28.         .[B1].Resize(dic.Count, 1) = Application.Transpose(dic.items)
    
29.         .[A1].Resize(dic.Count, 2).Sort key1:=.[A1], Header:=xlYes
    
30.         .[C1].Resize(dic2.Count, 1) = Application.Transpose(dic2.keys)
    
31.         .[D1].Resize(dic2.Count, 1) = Application.Transpose(dic2.items)
    
32.    End With
    
33.    
    
34.     '  MsgBox dic.Count - 1
    
35.     Set dic = Nothing
    
36.     Set dic2 = Nothing
    
37. End Sub

複製代碼

感謝 Hsieh 版大的指導！

ML089

回復 19# c_c_lai
回復 13# Hsieh
回復 4# stillfish00

我做3個標準圖型及統計數量以供大家測試用
我的程式也採用遞迴呼叫方式處理，原圖形執行時間大概2~3秒就能完成。
這程式寫得很慢很久，每個指令都是從網路上或參考大家的程式慢慢堆出來的，一共花了7~8小時才完成，也滿有成就感，請有語法待改進之處請大家多多指教。
下方為測試檔案
面積大小分佈統計_ML089.rar (139.12 KB)

下載次數: 10

2013-12-7 13:22

   

下載 (226.8 KB)

2013-12-7 13:22

ML089

回復 22# ML089
Timer使用的怪怪的，有時瞬間執行完成卻顯示9.X秒，Timer及TimeE計算出來也差很多(1.5秒及1.0秒)，幾乎差1.5倍，大家可以幫我看看嗎?

ML089

回復 22# ML089

這是DEBUD對話框輸入1時，可以產生陣列處理後的資料以供查核

   

下載 (232.11 KB)

2013-12-7 13:53

c_c_lai

回復 23# ML089
請教：

1.     '  ↓ 計算每組個數。 注意! Frequency 回傳 i + 1 組，所先將 i - 1
   
2.     Bins_array = Application.Evaluate("Row(1:" & i - 1 & ")")
   
3.     ArrN = Application.Frequency(Arr, Bins_array)
   
4.     MaxN = Application.Max(ArrN)
   
5. 
   
6.     '  ↓ 統計每組個數。 注意! Frequency 回傳 i + 1 組，所先將 MaxN - 1
   
7.     Bins_array = Application.Evaluate("Row(1:" & MaxN - 1 & ")")
   
8.     ArrF = Application.Frequency(ArrN, Bins_array)

複製代碼

Bins_array、ArrN 、MaxN 、ArrF  的內涵及作用，能否加以解析，
我對一些用語不很孰悉，且反應較遲鈍，謝謝囉！

stillfish00

回復 22# ML089
Nice Job，提取到Array加速很多，
我也發現我的方法邏輯上有問題，
另外，Time原本就只有到秒而已，時間亂跳是因為你把 inputbox 的時間也算了。

ML089

回復 26# stillfish00
哈哈，內行人一看就找出問題，我竟然怪timer函數怪怪的，感謝

c_c_lai

回復 26# stillfish00
回復 27# ML089
的確！
提取到Array確實加速很多，同時也解決了遲緩的困擾。
謝謝你等的指教！

ML089

回復 25# c_c_lai

Frequency 可以按F1看看說明。(以前我一開始看也不懂，這是正常的，多做題目才能慢慢了解)

用舉例說明
例一:有一群數字 {1,2,3,4,5,6,7,8,9}，要求3個範圍各有多少數字 1~2、3~7、8~9，公式如下
=FREQUENCY({1,2,3,4,5,6,7,8,9},{2,7,9}) = {2;4;2;0}，最後0是指大於9之數


用舉例說明
例二:例如以#22程式中下面部分程式來說明
   '  ↓ 計算每組個數。 注意! Frequency 回傳 i + 1 組，所先將 i - 1
    Bins_array = Application.Evaluate("Row(1:" & i - 1 & ")")
    ArrN = Application.Frequency(Arr, Bins_array)
    MaxN = Application.Max(ArrN)

    '  ↓ 統計每組個數。 注意! Frequency 回傳 i + 1 組，所先將 MaxN - 1
    Bins_array = Application.Evaluate("Row(1:" & MaxN - 1 & ")")
    ArrF = Application.Frequency(ArrN, Bins_array)

說明
   '  ↓ 計算每組個數。
1. 將每組連續0進行序號編碼放在陣列中，陣列資料例如下
   Arr={1,1,.."X" ,2,.."X" ,3,3,.."X" ,4,4,.."X" ,5,5,5,.."X" ,6,.."X" ,7,.."X" ,8,8,.."X" ,9,9,9,.."X"}
2. 我想求 1有幾個，2有幾個....9有幾個，可以用下列公式
   ArrN = FREQUENCY(Arr,{1,2,3,4,5,6,7,8}) = {2;1;2;2;3;1;1;2;3}
   回傳值表示為 1有3個、2有1個、3有2個、4有2個、5有3個、6有1個、7有1個、8有2個、9有3個
3. MaxN = Max({2;1;2;2;3;1;1;2;3}) = 3，所有組數中最大個數為 3 (後面計算要用)
       

    '  ↓ 統計每組個數。
4. 上面已經計算出每組的個數陣列 ArrN 及最大個數 MaxN，要統計各個數有幾組，公式如下
   ArrF = FREQUENCY(ArrN,{1,2,...,MaxN-1}) = {{2;1;2;2;3;1;1;2;3},{1,2}) = {3;4;2}       
   回傳值表示為 1個有3組、2個有4組、3個有2組

5. 公式中 Bins_array = Application.Evaluate("Row(1:" & i - 1 & ")") 就是要產生 {1,2,...i-1} 序號


6. 其他說明就要靠 GOOGLE 來查詢，多看幾個網頁說明就能明白，我也是一邊查一邊TRY才成功的。

剛接觸VBA功力尚淺，說明不清之處尚且見諒。

ML089

回復 28# c_c_lai

修正計時方式錯誤，將 INPUTBOX() 移至最前面，哇! 1秒多就能完成。
面積大小分佈統計_ML089.rar (141.68 KB)

下載次數: 2

2013-12-7 17:46