[發問] 資料彙整問題

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

TEST.zip (6.92 KB)

樓主熱帖

小孩

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 215
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-9-30

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2013-4-15 16:10 | 只看該作者

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

回復 1# child

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