[發問] 資列列自訂複製數量

luke

各位大大

sheet1工作表A1:C10為資料區, 其中C欄為列複製數量, 於C欄輸入值後,
按下 按鈕開始進行資料區複製,
若值為零時不做任何動作,
若值等於1時則複製該資料列1次,
若值大於1就依照所對應的值進行多次複製並對B欄(此為變數)按順序編號直到完成該值.
  
煩請先進 大大指導
TEST24.rar (31.26 KB)

下載次數: 5

2012-8-18 11:24

GBKEE

回復 1# luke
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim x As Integer, Rng As Range, i As Integer
   
4.     x = 1
   
5.     Set Rng = Cells(15, 1) '設於 [A15]
   
6.     Do
   
7.         For i = 1 To Cells(x, 3)          '3:C欄
   
8.             Rng = Cells(x, 1)             '1:A欄  '2:B欄
   
9.             Rng.Offset(, 1) = Cells(x, 2) & IIf(Cells(x, 3) > 1, "-" & i, "")
   
10.             Rng.Offset(, 2) = 1
    
11.             Set Rng = Rng.Offset(1)
    
12.         Next
    
13.         x = x + 1
    
14.     Loop While Cells(x, 3) <> ""
    
15. End Sub

複製代碼

luke

回復 2# GBKEE


    謝謝版大回覆

     若C欄中有空白格即C1:C10儲存格中, 任一儲存格有空白(非零值)時,
     資料列會被中斷複製命令
     例: C3="",下句要如何修改才會繼續未完的C5值如附檔所示
     Loop While Cells(x, 3) <> ""

    以上煩請先進指導
TEST24-1.rar (16.51 KB)

下載次數: 3

2012-8-18 17:47

GBKEE

回復 3# luke
3 改成  Loop While Cells(x, 2) <> ""

luke

回復 4# GBKEE

  謝謝版大

     僅B欄選定後的資料, 可否每隔3列再次複製至E欄
     如附檔 所示E15, E19, E23和E27 儲存格

    以上
   煩請先進 指導

TEST24-2.rar (25.46 KB)

下載次數: 8

2012-8-20 18:20

GBKEE

回復 5# luke

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim x As Integer, Rng As Range, i As Integer
   
4.     x = 1
   
5.     Set Rng = Cells(15, 1) '設於 [A15]
   
6.     Do
   
7.      For i = 1 To Cells(x, 3)          '3:C欄
   
8.            Rng = Cells(x, 1)        '1:A欄'2:B欄
   
9.            Rng.Offset(, 1) = Cells(x, 2) & IIf(Cells(x, 3) > 1, "-" & i, "")
   
10.            Rng.Offset(, 2) = 1
    
11.            Set Rng = Rng.Offset(4)  '改這裡 下移4列
    
12.      Next
    
13.      x = x + 1
    
14.          Loop While Cells(x, 2) <> ""
    
15. End Sub

複製代碼