作者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/cn.aspx?n=bbs/Visual_Basic/M.1479803042.A.0DF.html