增加重復資料筆數

請教各位大大
在資料中有這三個欄位，
已知數量這個欄為"數值"
如何依"數量"這位欄位為準，產生多筆資料
請問如何用vba程式寫出
原資料如下表
品號批號數量
aaaaa bbbbb 3----->變成3筆數量為1的data
aaaaa1 bbbbb1 2----->變成2筆數量為1的data

想要的結果

品號批號數量
aaaaa bbbbb 1
aaaaa bbbbb 1
aaaaa bbbbb 1
aaaaa1 bbbbb1 1
aaaaa1 bbbbb1 1

樓主熱帖

d8722468

小學生 Rank: 1

帖子: 7
主題: 3
精華: 0
積分: 10
點名: 0
作業系統: WIN7
軟體版本: 64
閱讀權限: 10
註冊時間: 2015-8-2
最後登錄: 2019-8-23

6^#

發表於 2015-9-23 18:45 | 只看該作者

非常感謝lpk187 大大~~
解決了小弟困難!!!
非常感謝!!!

TOP

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

5^#

發表於 2015-9-23 18:33 | 只看該作者

回復 4# d8722468

Sub ex()
Dim rng As Range
Dim arr()
For Each rng In Range("C2:c9")
If rng = "" Then GoTo 99
For i = 1 To rng.Value
x = x + 1
ReDim Preserve arr(1 To 3, 1 To x)
arr(1, x) = rng.Offset(, -2)
arr(2, x) = rng.Offset(, -1)
arr(3, x) = 1
Next
Next
99:
[A2].Resize(UBound(arr, 2), 3) = Application.WorksheetFunction.Transpose(arr)
End Sub

複製代碼

TOP

d8722468

小學生 Rank: 1

帖子: 7
主題: 3
精華: 0
積分: 10
點名: 0
作業系統: WIN7
軟體版本: 64
閱讀權限: 10
註冊時間: 2015-8-2
最後登錄: 2019-8-23

4^#

發表於 2015-9-23 17:58 | 只看該作者

感謝lpk187 大大~~小弟測試成功
再請教一下
那原資料可否刪除只留下新的DATA

品號       批號       數量
aaaaa       bbbbb       3----->變成3筆數量為1的data
aaaaa1       bbbbb1       2----->變成2筆數量為1的data
跑完程式後只留下這樣的結果
品號       批號       數量
aaaaa       bbbbb       1
aaaaa       bbbbb       1
aaaaa       bbbbb       1
aaaaa1       bbbbb1       1
aaaaa1       bbbbb1       1

TOP

lpk187