【VBA】一定間隔毎のデータを別の場所に詰めて貼り付ける方法

ある範囲をコピーして別の場所に貼り付けるやり方は「Copyメソッド」と使えば簡単にできます。

今回は、その応用で、

 

一定間隔ごとの範囲(行方向)をコピーする方法

 

についてVBAで、どのようにできるか書きたいと思います。

因みにですが、ここで紹介するVBAのコードは、

プロ顔負けといったすごいものではなく、こうすれば「一応できる」という初心者レベルでの解説となります。

あくまで個人レベルで作業することを想定していますのでご了承ください。

「スポンサーリンク」

 

全体像

今回の作業は、あるシート(シート名「全体」)にある全員の科目別テスト点数表から、別シート(シート名「科目別」)にコピーします。

一定間隔ごとのコピー_全体像

 

なお、「科目別シート」の表自体はフォーマットを予め用意し、値(点数)のみをコピーすることとします。

 

 

一定間隔ごとのコピー

今回の場合、上の赤枠(A君の国語の点数一覧)をコピーして、科目別シートの同じ赤枠欄に貼り付け、また、シートを全体シートに移して次にB君も同じ作業を・・・というコードの書き方でも極論できなくはありません。

 

が、

 

シートがあっちこっちいってしまうと、処理時間も長くなります(まあ、数千人とかの作業ではないので大した時間にはならないと思いますが)し、VBAに記述する内容が多くなってしまいます。

 

そこで、今回はFor~Nextの構文を使い、一旦全体シートの下部にコピーしてから、個別シートに一気に貼り付けるようにしたいと思います。

イメージで言うとこんな感じ。

一定間隔ごとのコピー_全体像2

 

こうすれば、シートがあちこちに遷移せずに済みます。

 

実践

では、早速やってみたいと思います。

 

まずは、元となる「全体シート」の状態はコチラ。

実践例1

 

赤数字(国語)の一覧をセル(C20)から下に詰めてコピーします。

 

早速ですが、サンプルコードはこんな感じ。

 

<サンプルコード>

Sub 一定間隔ごとのコピー()

Dim score_k As Range

Dim i As Long

Set score_k = Range(“C2:F2”)

 

For i = 0 To 2

score_k.Offset(i * 5).Copy Range(“C20”).Offset(i)

Next

End Sub

 

ポイント2つ(赤文字部分)。

 

ポイント1

1つ目のポイントは、For~Next構文で指定した変数「i」のスタート。

これを0にするところです。

 

これは、下記の「ポイント2」に関連するのですが、0は何を掛けても0です。

つまり、スタートはオフセットが0ですから、A君の国語の点数を拾うことが出来ます。

 

ポイント2

表を見ていただくとわかる通り、A君の点数(2行目:C2~F2)をセルC20にコピーした後、次にコピーするのはB君の7行目(C7~F7)。

行の間隔は5行あります。

 

ということで、i*5 としています。

 

スタート時点では、iが0ですからオフセットは0、つまりA君の点数(C2~F2)がコピーされます。

次(B君)は、iが1ですからオフセットは5。

ちゃんと、5行目が指定できます。

 

最終的には、こんな感じになります。

実践例2

 

「i×★」の、★部分さえ変更すれば、一定間隔ごと(★行ごと)のコピーが可能になります。

 

最終的には、別シート(科目別シート)に貼り付けるので・・・、

<サンプルコード>

Sub 一定間隔ごとのコピー()

Dim score_k As Range

Dim i As Long

Set score_k = Range(“C2:F2”)

 

For i = 0 To 2

score_k.Offset(i * 5).Copy Range(“C20”).Offset(i)

Next

Range(“C20:F22”).Copy Worksheets(“科目別”).Range(“B2”)

End Sub

 

うまく貼り付けられました。

 

【科目別シート】

実践例3

 

もし、C20セル以降に貼り付けたデータが不要なら、削除するコードを最終行に追加すれば良いと思います。

 

他の科目については、変数で別途指定するだけでOK。

※貼り付け場所は変えないといけませんが・・・

 

 

補 足

今回は、3名分(A君・B君・C君)で実施しましたが、場合によっては、人数があとから増えてくることも考えられます。

 

この場合は、もうひとつ宣言を増やして対処するのも手です。

 

<サンプルコード>

Sub 一定間隔ごとのコピー()

Dim score_k As Range

Dim i As Long

Dim rCnt As Long  ---ア

 

Set score_k = Range(“C2:F2”)

rCnt = Range(“A1”).CurrentRegion.Rows.Count ---イ

 

For i = 0 To rCnt-6/5 ---ウ

score_k.Offset(i * 5).Copy Range(“H2“).Offset(i) ---エ

Next

Range(“H2”).CurrentRegion.Copy Worksheets(“科目別”).Range(“B2”) ーーーオ

End Sub

 

● ア部分

rCntという変数は、次の「イ」にも関係しますが、表全体の行数を捉えるためのものです。

 

● イ部分

『.Rows.Count』で表全体の行数を参照します。

 

● ウ部分

ちょっと複雑に見えるかもしれませんが、国語の点数となる行が何行目かを考えればわかります。

先例のように、A君~C君の3人がいる場合、表全体の行数は「16」。

 

これを当てはめると、(16-6)/5=2ですから、

For i 0 to 2

となります。

 

ひとり増えた場合は、行数が5増えるわけですから、

(21-6)/5=3

となり、何人増えても自動で国語の点数に対するセルを指定できます。

 

● エ部分

先例では、貼り付け位置を表の下部にしていましたが、人数が増えてくると表下へのセル指定では難しくなります。

なので、表の右側の任意のセル(今回は「H2」)に貼り付けるようにしました。

 

これであれば、人数が何人増えようが問題ありません。

 

● オ部分

貼り付ける元データも、人数が増える事で範囲が変わってくるので、ここでは、CurrentRegionを使用しています。

これで全体の表からコピーしてきた分は、すべて問題なくコピーできます。

 

 

ページ先頭へ戻る

「スポンサーリンク」

最新情報をチェックしよう!