Excel VBA質問箱 IV

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

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


22 / 13290 ツリー ←次へ | 前へ→

【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.でペーストした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 さん:

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

ご丁寧に教えていただきまして、ありがとうございました。

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