stillfish00

回復 9# c_c_lai
.Parent 是指到 前面 With Sheets(1).[A1].CurrentRegion 的 parent 也就是 sheets(1)
直接用 Range(prev) ，應該相當於ActiveSheet.Range(prev)，照道理是沒啥影響。

ML089

回復 1# c_c_lai

請問檔案案中有圖片，如何將圖片的圖形轉成 0, 255數字

算0的面積，我初步算完有381組(也不知道對不對還沒有驗算)，其中有很多組是 0，需要把0組過濾掉嗎?
有標準答案可以給我驗證媽?

Hsieh

回復 2# c_c_lai
資料量龐大，且因為各個儲存格必須要以遞迴方式測是連續與否
跑的有點久
用縮小資料量先行測試應該還OK，你測試看看
面積大小分佈統計.zip (112.96 KB)

下載次數: 11

2013-12-6 15:05

c_c_lai

回復 12# ML089
不好意思現在才回來！
那張圖片只是樣張而已，
我個人亦在探索中，那是我另一友人的提問，
也多蒙各位鼎力協助，希望能從中找出頭緒。

c_c_lai

回復 13# Hsieh
謝謝您！
待測出結果後再行向您報告。

ML089

回復 14# c_c_lai

請問連在一起得原則是什麼，請看圖中說明

下載 (95.49 KB)

2013-12-6 18:25

c_c_lai

回復 13# Hsieh
回復 16# ML089
回復 11# stillfish00
謝謝大家，終於測試出結果了，雖然速度上稍稍慢了點：

下載 (22.21 KB)

2013-12-6 20:51

下載 (31.51 KB)

2013-12-6 20:51

c_c_lai

回復 13# Hsieh
回復 16# ML089
回復 11# stillfish00
面積大小分佈統計B.rar (108.71 KB)

下載次數: 6

2013-12-6 20:52

感謝各位的幫忙，如還有更佳效益的解決方案，
敬請不吝指教！

c_c_lai

回復 16# ML089
以常理來論， 10 與 25 應無彼此間之串聯，應屬不同之區塊才是，
你在實作上是如何解析的？

c_c_lai

回復 16# ML089
Hsieh 版大他是應用 "遞迴" 的處理技巧，來求出各歸屬區塊的範圍，
這種點及於面的運用是個蠻不錯的 Idea，你看看程式碼細細地去推敲，
是蠻值得回味的， 在裏頭我加上了 sRng 的位址紀錄處理，並同時求取
每個區塊的實際位址數，以提供參考之用：

1. Option Explicit
   
2. 
   
3. Public s As Long
   
4. Public sRng As Variant
   
5. 
   
6. Sub ex()
   
7.     Dim dic As Object
   
8.     Dim A As Range, Rng As Range, sPos As Range
   
9.    
   
10.     Set dic = CreateObject("Scripting.Dictionary")
    
11.     dic("連續數量") = "數量"
    
12.     '   增列部分
    
13.     工作表2.[C1] = "連續位址"
    
14.     工作表2.[D1] = "組合數量"
    
15.    
    
16.     With 工作表1
    
17.         Set Rng = .Range("A1").CurrentRegion
    
18.         Rng.Replace 0, Empty, xlWhole
    
19.         
    
20.         Set sPos = 工作表2.[C2]
    
21.         Set A = Rng.Find(Empty)
    
22.         
    
23.         Do Until A Is Nothing
    
24.             A = 0: s = 1
    
25.             Cnt A
    
26.             dic(s) = dic(s) + 1
    
27.             
    
28.             sPos = sRng
    
29.             sPos.Offset(0, 1) = Range(sRng).Count
    
30.             
    
31.             Set A = Rng.Find(Empty)
    
32.             
    
33.             Set sPos = sPos.Offset(1)
    
34.         Loop
    
35.     End With
    
36.    
    
37.     With 工作表2
    
38.         .[A1].Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    
39.         .[B1].Resize(dic.Count, 1) = Application.Transpose(dic.items)
    
40.         .[A1].Resize(dic.Count, 2).Sort key1:=.[A1], Header:=xlYes
    
41.     End With
    
42.    
    
43.     '  MsgBox dic.Count - 1
    
44.     Set dic = Nothing
    
45. End Sub
    
46. 
    
47. Function Cnt(Rng As Range)
    
48.     Dim A As Range, Temp As Range
    
49.     Dim i As Integer
    
50.         
    
51.     For Each A In Rng
    
52.         For i = -1 To 1 Step 2
    
53.             If A.Row + i > 0 And A.Row + i < 工作表1.Range("A1").CurrentRegion.Rows.Count Then
    
54.                 If IsEmpty(A.Offset(i, 0)) Then Set Temp = Union(Rng, A.Offset(i, 0))   '  "$BF$4:$BF$5"
    
55.             End If
    
56.         Next
    
57.         For i = -1 To 1 Step 2
    
58.             If A.Column + i > 0 And A.Column + i < 工作表1.Range("A1").CurrentRegion.Columns.Count Then
    
59.                 If IsEmpty(A.Offset(, i)) Then Set Temp = Union(Rng, A.Offset(, i))   '  "$BF$4:$BG$4"
    
60.             End If
    
61.         Next
    
62.     Next
    
63. 
    
64.     If Not Temp Is Nothing Then      '  True
    
65.         Temp = 0
    
66.         s = Temp.Count
    
67.         sRng = Temp.Address
    
68.         Cnt Temp
    
69.     End If
    
70. End Function

複製代碼