[VBA ] 根據數字做為重複次數貼上文字值

看板Visual_Basic作者luckid (luckid)時間8年前 (2016/11/22 16:24)推噓0(0推 0噓 0→)

留言0則, 0人參與討論串1/2 (看更多)

各位前輩好, 小弟在練習時寫了以下程式碼,用文字敘述有些困難, 附上圖片以供參考, 運行前資料示意: http://imgur.com/a/f6J1d 運行後資料示意: http://imgur.com/a/TFgUP 附上程式碼如下以供參考,請前輩不吝指正謬誤與不足處,感謝: '------------------------------------------------------ Sub test() '程式功能簡述: 'A欄為文字資料,B欄為數字,代表希望重複的次數. 'ex:若A2為"AAA",B2為3,則表示希望在D欄,AAA可以重複貼3次. '運行程式後,可將A欄的資料,以B欄做為重複的次數,貼至D欄 Dim Arr, Brr, tt, N, Cnt '抓取資料範圍並將值代入陣列 Arr = Range("a2:b" & Cells(Rows.Count, "a").End(3).Row) '先清空等會要貼上用的範圍 Range("d2", Cells(Rows.Count, "d")).ClearContents '求出總重複次數,亦即B欄的數字總和 For i = 1 To UBound(Arr) tt = tt + Arr(i, 2) Next i '將Brr以B欄數字為總和重新定義大小 ReDim Brr(1 To tt, 1 To 1) For j = 1 To UBound(Arr) 'N為單筆資料重複的次數起始值,做為k迴圈起始之用. 'j= 1時,起始值為1,之後則否 'Cnt為資料重複的總次數,做為k迴圈結束之用. 'j=1時,即B欄第一個數值,之後則否 If N = "" Then N = 1 If Cnt = "" Then Cnt = Arr(1, 2) '將文字資料依據各自的重複次數傳入Brr For k = N To Cnt Brr(k, 1) = Arr(j, 1) Next k '此處需新增if條件以免出現錯誤 If j <> UBound(Arr) Then '第二筆資料開始累加N與Cnt N = N + Arr(j, 2) Cnt = Cnt + Arr(j + 1, 2) End If Next j '將陣列資料貼至d欄 [d2].Resize(UBound(Brr), 1) = Brr End Sub '------------------------------------------------------- 小弟初學vba, 寫得非常不好, 希望有前輩能不吝指正不足處, 鞭得越用力越好, 但可以的話斗膽請求儘可能不利用excel特有的功能. 小弟已有在office版問過此問題的變化版本, 也承蒙soyoso前輩用resize及offset的方式快速解答,非常高明, 小弟擅自將其已公開(在office版可直接觀看)之程式碼略作修改後附上如下, 非我自創: For i = 2 To 10 Cells(i, 1).Copy _ Cells(Rows.Count, 4).End(3).Offset(1).Resize(Cells(i, 2), 1) Next 主要作用的程式碼僅需一行即可解決,非常驚人. 但是這是利用excel本身的特性去解題. 當然做為單純解決問題來看, 先不論運算速度,此方式可說是非常利害的. 只是,小弟目前想要做的練習,比較是傾向於練習撰寫程式的思路. 因excel本身,即使是2007版本, 也已內建非常多強大的功能, 若屢次運用excel特性或是內建功能去解決問題, 跳至其他程式語言時恐無法適應. 若可以的話,希望前輩能不吝指點一二, 有違版規或語氣不當處或國文語法有謬誤處(小聲)也請不吝指點, 十分感謝. -- https://www.youtube.com/watch?v=B_CMmbFexbM