標題: [發問] 資料彙整問題 [打印本頁]

---

作者: child    時間: 2013-4-15 13:00     標題: 資料彙整問題

問題說明：
請益如何針對A欄代碼自動編碼(初始值為1)，依序比對A欄代碼連續相同者自動編碼的最大最小值，若只有單一值則最大最小值相同。
詳細資料與問題說明如附件，謝謝大家的幫忙 ^_^[attach]14675[/attach][attach]14675[/attach][attach]14675[/attach][attach]14675[/attach]

---

作者: Hsieh    時間: 2013-4-15 16:10

本帖最後由 Hsieh 於 2013-4-16 08:23 編輯

回復 1# child

1. Sub ex()
   
2. Dim Ar()
   
3. i = 2: s = 1  'i為起始列號，s為起始編碼
   
4. With Sheets("TEST")
   
5. Do Until i > .[A2].End(xlDown).Row  '當列號大於資料尾列號則停止迴圈
   
6.    temp = .Cells(i, 1).Value  '記住A欄
   
7.    Do Until .Cells(i, 1) <> temp Or i > .[A2].End(xlDown).Row  '當A欄不同時或列號大於資料尾列號則停止迴圈
   
8.       temp = .Cells(i, 1): k = k + 1  '記住A欄，k計算編碼
   
9.       i = i + 1
   
10.    Loop
    
11.    ReDim Preserve Ar(j)  '擴充陣列
    
12.    Ar(j) = Array(temp, s, k)  '將結果置入陣列
    
13.    'Ar(j) = Array(temp, s-0.5, k+0.5)  '最小減0.5，最大加0.5
    
14.    j = j + 1  '下次陣列的大小
    
15.    s = k + 1  's為下個編碼起始
    
16. Loop
    
17. .[E7].Resize(j, 3) = Application.Transpose(Application.Transpose(Ar))  '將陣列寫入工作表
    
18. End With
    
19. End Sub

複製代碼

---

作者: child    時間: 2013-4-15 17:12

回復 2# Hsieh


很謝謝Hsieh版主的幫忙，因本身的程度不夠，不知是否可麻煩版主幫忙註解程式的邏輯。
如果想把計算結果每列的最大值+0.5和最小值-0.5，請益如何改寫，再麻煩版主幫忙了^_^

---

作者: luke    時間: 2013-4-16 17:48

回復 3# child


   將這句   Ar(j) = Array(temp, s, k)
改成   Ar(j) = Array(temp, s - 0.5, k + 0.5)

---

作者: child    時間: 2013-4-16 18:21

回復 2# Hsieh


    很謝謝Hsieh版主的幫忙和教學，感激不盡^__^

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)