標題: 增加重復資料筆數 [打印本頁]

---

作者: d8722468    時間: 2015-9-23 16:32     標題: 增加重復資料筆數

請教各位大大
在資料中有這三個欄位，
已知數量這個欄為"數值"
如何依"數量"這位欄位為準，產生多筆資料
請問如何用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    時間: 2015-9-23 16:37

---

作者: lpk187    時間: 2015-9-23 17:46

回復 2# d8722468

1. Sub ex()
   
2. Dim rng As Range
   
3. For Each rng In Range("C2:c9")
   
4. If rng = "" Then Exit Sub
   
5.     For i = 1 To rng.Value
   
6.         ro = Cells(Rows.Count, 1).End(xlUp).Row + 1
   
7.         Cells(ro, 1) = rng.Offset(, -2)
   
8.         Cells(ro, 2) = rng.Offset(, -1)
   
9.         Cells(ro, 3) = 1
   
10.     Next
    
11. 
    
12. Next
    
13. End Sub

複製代碼

---

作者: d8722468    時間: 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

---

作者: lpk187    時間: 2015-9-23 18:33

回復 4# d8722468

1. Sub ex()
   
2. Dim rng As Range
   
3. Dim arr()
   
4. For Each rng In Range("C2:c9")
   
5. If rng = "" Then GoTo 99
   
6.     For i = 1 To rng.Value
   
7.         x = x + 1
   
8.         ReDim Preserve arr(1 To 3, 1 To x)
   
9.         arr(1, x) = rng.Offset(, -2)
   
10.         arr(2, x) = rng.Offset(, -1)
    
11.         arr(3, x) = 1
    
12.     Next
    
13. Next
    
14. 99:
    
15. [A2].Resize(UBound(arr, 2), 3) = Application.WorksheetFunction.Transpose(arr)
    
16. End Sub

複製代碼

---

作者: d8722468    時間: 2015-9-23 18:45

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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)