返回列表 上一主題 發帖

[發問] 資料彙整問題

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題