Excel VBA質問箱 IV

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

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


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

【75655】表を5行ごとにコピー むん 14/6/6(金) 16:35 質問[未読]
【75658】Re:表を5行ごとにコピー γ 14/6/6(金) 22:17 発言[未読]
【75660】Re:表を5行ごとにコピー γ 14/6/8(日) 0:09 回答[未読]

【75655】表を5行ごとにコピー
質問  むん  - 14/6/6(金) 16:35 -

引用なし
パスワード
   こんにちわ。
早速質問させてください。

B5とC5列に表が入っています。
下にデータが続いております(その時々でデータ量が違う)

B列は題名みたいなもので、例えば‥

   B      C
5      | 2個  
6 リンゴ  | 4個
7      | 8個
8 みかん  | 1個
9 ぶどう  | 3個
10      | 5個


このような感じで、行数もバラバラ、結合されている状態です。
縦長の表なので、スクロールが大変なので
結合セルを5個づつ、一つ空白セルを作りズラしていきたいのです。

   B      C   D   E   F
5      | 2個 |  | B列の| 
6 リンゴ  | 4個 |  | 5行目|
7      | 8個 |  | から |
8 みかん  | 1個 |  |   |
9 ぶどう  | 3個 |  |   |
10      | 5個 |  |   |

BC5行 EF5行 HI5行。。
のように表の最後が来るまでループさせて位と思っております。
色々試したのですが、結合している為、エラーがでてしまい
悪戦苦闘中です。

お力を貸してください。よろしくお願い致します。

【75658】Re:表を5行ごとにコピー
発言  γ  - 14/6/6(金) 22:17 -

引用なし
パスワード
   ▼むん さん:
作業前で、結合されているセルはどこですか?
B5:B7、B9:B10ということですか?

>B列は題名みたいなもので、例えば‥
>
>   B      C
>5      | 2個  
>6 リンゴ  | 4個
>7      | 8個
>8 みかん  | 1個
>9 ぶどう  | 3個
>10      | 5個


>結合セルを5個づつ、一つ空白セルを作りズラしていきたいのです。
>
>   B      C   D   E   F
>5      | 2個 |  | B列の| 
>6 リンゴ  | 4個 |  | 5行目|
>7      | 8個 |  | から |
>8 みかん  | 1個 |  |   |
>9 ぶどう  | 3個 |  |   |
>10      | 5個 |  |   |
>
>BC5行 EF5行 HI5行。。

仕上がりの状態を記載してください。
結合セルはやめたほうがいいと思いますが、
もしあるなら、上記と同様に結合セルを示して下さい。

# 上記のことを提示されれば、回答がつきやすくなると思われます。

【75660】Re:表を5行ごとにコピー
回答  γ  - 14/6/8(日) 0:09 -

引用なし
パスワード
   勝手に想像してコードを書くと、以下のようになるかもしれません。

ただ、もっと大切なことは、表の正しい使い方を実践することです。
こうしたことは、表を複雑にするだけで、悪い方向に進んでいます。

今後、この表を使って分析などに使用するなら、
非常に使い勝手が悪い物になり、手に負えなくなります。
こうしたことは避けた方がいいです。

(1)見出し部分はともかく、データ部分にはセル結合は使わない。

5 リンゴ  | 2個
6 リンゴ  | 4個
7 リンゴ  | 8個
8 みかん  | 1個
9 ぶどう  | 3個
10 ぶどう  | 5個
とすべきです。

(2)同一種類のデータなら、一列で管理すべき。
  複数列に分けてしまうと、ソートだとか、削除、追加が発生したときに、
  面倒なことになります。

-----------------------------------
使わない方がいいと思うが、一応コードを示しておきます。
こうしたコードにトライするよりも、表の正しい使い方をマスターすることを
勧めます。


Dim r0     As Range
Dim r1     As Range
Dim fromRange  As Range
Dim toRange   As Range

Sub test()
  Dim lastRow As Long

  lastRow = Cells(Rows.Count, 2).End(xlUp).Row
  
  '最初の5コをコピー
  Set r0 = Range("B2")
  Set toRange = Cells(2, 5)
  Call myCopy
  
  Do
    Set r0 = r1.Offset(1)
    Set toRange = toRange.Offset(0, 3)
    Call myCopy
    If r1.Row >= lastRow Then Exit Do
  Loop
End Sub

Function myCopy()
  Dim j As Long

  Set r1 = r0
  For j = 1 To 4
    Set r1 = r1.Offset(1)
  Next
  Set fromRange = Range(r0.MergeArea, r1.MergeArea)
  ' そのままコピーペイスト
  fromRange.Resize(, 2).Copy toRange
End Function

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