作者luckid (luckid)
看板Visual_Basic
標題[VBA ] 根據數字做為重複次數貼上文字值
時間Tue Nov 22 16:23:59 2016
各位前輩好,
小弟在練習時寫了以下程式碼,用文字敘述有些困難,
附上圖片以供參考,
運行前資料示意:
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
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 59.125.131.218
※ 文章網址: https://webptt.com/m.aspx?n=bbs/Visual_Basic/M.1479803042.A.0DF.html