Excel VBA質問箱 IV

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

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


2741 / 13645 ツリー ←次へ | 前へ→

【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 発言[未読]

【66269】値に応じて、行をコピー、貼り付けする回...
質問  ロシツキー  - 10/8/15(日) 12:18 -

引用なし
パスワード
   初めまして、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回貼り付けます。

このような処理は出来ますでしょうか?
恐れ入りますが、ご教示願います。

【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

【66271】Re:値に応じて、行をコピー、貼り付けす...
発言  kanabun  - 10/8/15(日) 14:22 -

引用なし
パスワード
   失礼しました。
暑さのせいで? ↑無駄な全文引用、してしまいました。。m(__)m

要は、行挿入なら(行削除でもですけど)
「したから」処理していってください

ということが言いたかったことです。
よろしく

【66272】Re:値に応じて、行をコピー、貼り付けす...
発言  kanabun  - 10/8/15(日) 15:49 -

引用なし
パスワード
   ▼ロシツキー さん:

ごめんなさい。仕様を勘違いしていたようです。

>                    A    1    
>                    B    1    
>                    C    0    
>                    D    1    
>                    E    5    
>
>
>タイトル>                            
>ここに貼り付けていきます

ということなんですね?

単純化して、 A列のデータだけ 指定の行数だけ
【別のセル範囲】にコピーする例を示します。
配列を使っています。

Sub Try2()
 Dim a, b() As String
 Dim CopyTimes, max As Long
 Dim i As Long, j As Long, k As Long
 Dim n As Long
 
 CopyTimes = Range("CopyTimes").Value
 max = WorksheetFunction.max(Range("CopyTimes").Columns(2))
 
 a = Range("A1").CurrentRegion.Resize(, 1).Value
 ReDim b(1 To UBound(a) * max, 1 To 1)
 n = 1
 b(n, 1) = a(1, 1)  '--- タイトルのコピー
 For i = 2 To UBound(a)
   For j = 1 To UBound(CopyTimes)
     If InStr(a(i, 1), CopyTimes(j, 1)) Then
        '--------- 配列内で指定回数 Copy
       For k = 1 To CopyTimes(j, 2)
         n = n + 1     '配列内位置カウンタ
         b(n, 1) = a(i, 1)
       Next
       Exit For
     End If
   Next
 Next
 '------------ 配列(n行)を指定セルに貼付け
 Range("A20").Resize(n, 1).Value = b
End Sub

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