Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


15938 / 76734 ←次へ | 前へ→

【66270】Re:値に応じて、行をコピー、貼り付けする回数を指定できますか
発言  kanabun  - 10/8/15(日) 14:14 -

引用なし
パスワード
   ▼ロシツキー さん:
>初めまして、VBA初心者です。
>質問があり書き込みいたしました。
>
>下記の様に、一つのシートにA〜Eの値が入力されたセルと、それらの情報が入力された行があります。それらの行を値に応じて、下の行にコピー貼り付けしたいのですが、そのような処理はできますか?
>−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
>タイトル>                            
>Aの情報が入った行                        
>Bの情報が入った行                            
>Cの情報が入った行                            
>Dの情報が入った行
>Eの情報が入った行                            
>                  
>                    A    1    
>                    B    1    
>                    C    0    
>                    D    1    
>                    E    5    
>
>
>タイトル>                            
>ここに貼り付けていきます
>−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
>例えば、上の場合、
>Aの値が1であるので、Aの情報が入った行を1回、
>Bの値が1であるので、Bの情報が入った行を1回、
>Cの値が0であるので、Cの情報が入った行を0回、
>Dの値が1であるので、Dの情報が入った行を1回、
>Eの値が5であるので、Eの情報が入った行を5回貼り付けます。
>
>このような処理は出来ますでしょうか?
>恐れ入りますが、ご教示願います。

仕様がよくわからないので、
あるシートのA列に

>タイトル>                            
>Aの情報が入った行                        
>Bの情報が入った行                            
>Cの情報が入った行                            
>Dの情報が入った行
>Eの情報が入った行 

と書き込みがあり、キー別コピー回数の対応表が 「CopyTimes」と
名前定義したセル範囲に 書いてあるという前提でお話しますと、
手動でやるばあい
A列の 最終行から うえへ順にセルを調べていって、
A〜Eのキー情報があったら、その行をコピーして その下の行を
コピー回数分選択して行挿入 ... していけば

>タイトル>                            
>Aの情報が入った行                        
>Aの情報が入った行                        
>Bの情報が入った行                            
>Bの情報が入った行                            
>Cの情報が入った行                            
>Dの情報が入った行
>Dの情報が入った行
>Eの情報が入った行 
>Eの情報が入った行 
>Eの情報が入った行 
>Eの情報が入った行 
>Eの情報が入った行 
>Eの情報が入った行 

となります。
仮に こういう処理をしたいのなら、上の手操作をマクロに
してこんな風になります。

Sub Try1()
 Dim CopyTimes
 Dim r As Range
 Dim c As Range
 Dim i As Long, j As Long
 
 CopyTimes = Range("CopyTimes").Value
 Set r = Range("A2", Range("A1").End(xlDown))
 For i = r.Count To 1 Step -1
   Set c = r.Item(i)
   For j = 1 To UBound(CopyTimes)
     If CopyTimes(j, 2) > 0 Then
       If InStr(c.Value, CopyTimes(j, 1)) Then
         With c.EntireRow
           .Copy
           .Offset(1).Resize(CopyTimes(j, 2)).Insert
         End With
         Exit For
       End If
     End If
   Next
 Next
End Sub
2 hits

【66269】値に応じて、行をコピー、貼り付けする回数を指定できますか ロシツキー 10/8/15(日) 12:18 質問
【66270】Re:値に応じて、行をコピー、貼り付けする... kanabun 10/8/15(日) 14:14 発言
【66271】Re:値に応じて、行をコピー、貼り付けする... kanabun 10/8/15(日) 14:22 発言
【66272】Re:値に応じて、行をコピー、貼り付けする... kanabun 10/8/15(日) 15:49 発言

15938 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free