標題: 製作清單 [打印本頁]

---

作者: carzyindex    時間: 2012-10-9 22:27     標題: 製作清單

本帖最後由 carzyindex 於 2012-10-9 22:28 編輯

資料來源        數量        產生1        產生2
xxx        4        xxx        1
yyy        3        xxx        2
zzz        4        xxx        3
                xxx        4
                yyy        1
                yyy        2
                yyy        3
                zzz        1
                zzz        2
                zzz        3
                zzz        4



希望按下程式讀取A  B欄位  產生C   D 欄位

跪求各位大大幫忙

---

作者: kimbal    時間: 2012-10-10 21:21

1. Sub test()
   
2.     Dim mainRowCnt, subRowCnt, extRowCnt
   
3.     extRowCnt = 1
   
4.     Dim rng As Range
   
5.     Set rng = Range(Range("A2"), Range("B2").End(xlDown))
   
6.     For mainRowCnt = 1 To rng.Rows.Count
   
7.         For subRowCnt = 1 To rng.Cells(mainRowCnt, 2)
   
8.             Range("C1").Offset(extRowCnt, 0) = rng.Cells(mainRowCnt, 1)
   
9.             Range("C1").Offset(extRowCnt, 1) = subRowCnt
   
10.             extRowCnt = extRowCnt + 1
    
11.         Next
    
12.     Next
    
13.    
    
14. End Sub

複製代碼

---

作者: carzyindex    時間: 2012-10-10 22:08

回復 2# kimbal


    感謝回復
    超好用

---

作者: Hsieh    時間: 2012-10-10 23:33

回復 1# carzyindex

1. Sub ex()
   
2. Dim Ar(), A As Range, i%, s&
   
3. For Each A In Range([B2], [B2].End(xlDown))
   
4.   For i = 1 To A
   
5.      ReDim Preserve Ar(s)
   
6.      Ar(s) = Array(A.Offset(, -1).Value, i)
   
7.      s = s + 1
   
8.   Next
   
9. Next
   
10. [C2].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
    
11. End Sub

複製代碼

---

作者: tatun    時間: 2012-10-15 10:48

回復 1# carzyindex


    原來還有這種方式
真是學到了

---

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