Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
378 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【80714】データを横にペーストしていきたい リョウ 19/4/21(日) 1:29 質問[未読]
【80715】Re:データを横にペーストしていきたい γ 19/4/21(日) 6:22 回答[未読]
【80716】Re:データを横にペーストしていきたい リョウ 19/4/21(日) 11:13 質問[未読]
【80717】Re:データを横にペーストしていきたい γ 19/4/21(日) 14:10 回答[未読]
【80718】Re:データを横にペーストしていきたい リョウ 19/4/21(日) 14:23 お礼[未読]
【80719】Re:データを横にペーストしていきたい γ 19/4/21(日) 21:26 回答[未読]
【80720】Re:データを横にペーストしていきたい リョウ 19/4/22(月) 20:30 お礼[未読]
【80714】データを横にペーストしていきたい
質問  リョウ E-MAIL  - 19/4/21(日) 1:29 -
引用なし
パスワード
   VBAの初心者です。
下記のコピー＆ペーストを、For〜Nextのように繰り返して実行したいのですが、コードのイメージが涌かず質問させていただきます。


【質問内容】
・“A列〜C列”にデータがあるとして、そのデータをE列から横に繋げてペーストしてきたいです。

　1.“A1〜C1”をコピーして、“E1（〜G1）”にペースト。
　2.“A2〜C2”をコピーして、1.でペーストした１つの右の“H1（〜J1）”にペースト。
　3.“A列〜C列”のデータを3回ペーストしたら、次のデータは1つ下のE列の行からペーストしていく。
　4.これを“A列〜C列”にデータが入力されているところまで繰り返す。
　　（＝A列にデータが入力されているところまで）


図が分かりづらいかもしれませんが、どなたかご教授いただけないでしょうか。
もし過去に同様の質問があるようでしたら、お教えいただけると幸いです。

宜しくお願いいたします。

--------------------------------------------------------------------

　 A　 B　 C　　D　　E　　F　　G　　H　　I　　J　　K　　L　　M
1　A1　B1　C1　　　　A1　 B1　 C1 　A2 　B2 　C2 　A3　 B3 　C3
2　A2　B2　C2　　　　A4 　B4　 C4　　　　　　　　　　　　　　　　　　　　　
3　A3　B3　C3　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
4　A4　B4　C4


　　Range("A1:C1").Select
　　Selection.Copy
　　ActiveSheet.Paste Range("E1")
　　
　　Range("A2:C2").Select
　　Selection.Copy
　　ActiveSheet.Paste Range("H1")
　　
　　Range("A3:C3").Select
　　Selection.Copy
　　ActiveSheet.Paste Range("K1")

　　'3回ペーストしたら、下の行にペーストしていく
　　Range("A4:C4").Select
　　Selection.Copy
　　ActiveSheet.Paste Range("E2")
　　
　　Application.CutCopyMode = False
【80715】Re:データを横にペーストしていきたい
回答  γ  - 19/4/21(日) 6:22 -
引用なし
パスワード
   色々な書き方があると思いますが、下記は基本的だろうと思います。
大量にある場合は、配列を利用することになると思います。

Sub test()
　　Dim lastRow As Long
　　Dim k　　　 As Long
　　Dim rng　　 As Range
　　
　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　
　　'最初の貼付先位置
　　Set rng = Cells(1, 5)
　　
　　For k = 1 To lastRow
　　　　'コピーペイスト
　　　　Cells(k, 1).Resize(1, 3).Copy rng
　　　　
　　　　'次の貼付先位置を設定
　　　　If k Mod 3 = 0 Then
　　　　　　Set rng = rng.Offset(1, -6)
　　　　Else
　　　　　　Set rng = rng.Offset(0, 3)
　　　　End If
　　Next
End Sub
【80716】Re:データを横にペーストしていきたい
質問  リョウ  - 19/4/21(日) 11:13 -
引用なし
パスワード
   ▼リョウ さん：

ご教授ありがとうございます。
希望通りの処理が行われることを確認しました。
また「Mod」の使い方も理解しました。

＞大量にある場合は、配列を利用することになると思います。
度々で申し訳ございませんが、ここの文言がピンときていません。。
実際はもっとデータが多いのですが、宜しければもう少し具体的に教えていただけると助かります。

宜しくお願いいたします。
【80717】Re:データを横にペーストしていきたい
回答  γ  - 19/4/21(日) 14:10 -
引用なし
パスワード
   時間がかかるのは、シートへの書き込みです。
各セルにその都度書き込むとそれだけ時間が掛かりますから、
いったん二次元配列に結果を書き込んでおいて、
それを一回の処理でまとめてシートに書き込む方法です。
トライしてみてください。

もっとも数千行くらいのデータであれば今の方法で十分でしょう。
数万〜数十万行のオーダーなら効果は大きいと思います。
【80718】Re:データを横にペーストしていきたい
お礼  リョウ  - 19/4/21(日) 14:23 -
引用なし
パスワード
   ▼Y さん：

>いったん二次元配列に結果を書き込んでおいて、
>それを一回の処理でまとめてシートに書き込む方法です。
>トライしてみてください。
なるほど。
あとは自分で色々と調べてみます。


>もっとも数千行くらいのデータであれば今の方法で十分でしょう。
>数万〜数十万行のオーダーなら効果は大きいと思います。
あっても数百行くらいのデータですので、特に考慮する必要は無さそうということで理解しました。

早々にご返信いただきまして、本当にありがとうございました。
また機会ありましたら、宜しくお願いいたします。
【80719】Re:データを横にペーストしていきたい
回答  γ  - 19/4/21(日) 21:26 -
引用なし
パスワード
   配列を使ったコード例。（色々な書き方があるので一例として）

Sub test2()
　　Dim lastRow As Long
　　Dim mysize　As Long
　　Dim mat()　 As Variant
　　Dim v　　　 As Variant
　　Dim k　　　 As Long
　　Dim j　　　 As Long
　　Dim m　　　 As Long
　　Dim kk　　　As Long
　　
　　Dim t　　　 '経過時間計測用
　　t = Timer
　　
　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　
　　'できあがりの表の行数
　　mysize = WorksheetFunction.Ceiling(lastRow / 3, 1)
　　
　　'結果一時保持用配列の大きさを宣言
　　ReDim mat(1 To mysize, 1 To 9)
　　　　　　　　
　　'元データを配列vに取り込む
　　v = Range("A1").CurrentRegion.Resize(mysize * 3, 3).Value

　　For k = 1 To mysize * 3 Step 3
　　　　kk = Int((k - 1) / 3) + 1
　　　　For j = 1 To 3
　　　　　　For m = 1 To 3
　　　　　　　　mat(kk, (j - 1) * 3 + m) = v(k + j - 1, m)
　　　　　　Next
　　　　Next
　　Next

　　'纏めて書込む
　　[E1].Resize(mysize, 9).Value = mat
　　
　　Debug.Print "配列利用　"; Timer - t
End Sub
【80720】Re:データを横にペーストしていきたい
お礼  リョウ  - 19/4/22(月) 20:30 -
引用なし
パスワード
   ▼Y さん：

サンプルをありがとうございます。
ただ正直、理解しきれていないので時間を掛けて習得したいと思います・・。

ご丁寧に教えていただきまして、ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
378 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free