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の値が１であるので、Aの情報が入った行を１回、
Bの値が１であるので、Bの情報が入った行を１回、
Cの値が０であるので、Cの情報が入った行を０回、
Dの値が１であるので、Dの情報が入った行を１回、
Eの値が５であるので、Eの情報が入った行を５回貼り付けます。

このような処理は出来ますでしょうか？
恐れ入りますが、ご教示願います。
【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の値が１であるので、Aの情報が入った行を１回、
>Bの値が１であるので、Bの情報が入った行を１回、
>Cの値が０であるので、Cの情報が入った行を０回、
>Dの値が１であるので、Dの情報が入った行を１回、
>Eの値が５であるので、Eの情報が入った行を５回貼り付けます。
>
>このような処理は出来ますでしょうか？
>恐れ入りますが、ご教示願います。

仕様がよくわからないので、
あるシートの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