Excel VBA質問箱 IV

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

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


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

【77794】セルの結合→貼付け ぼぶ 15/12/23(水) 3:59 質問[未読]
【77795】Re:セルの結合→貼付け γ 15/12/23(水) 6:19 発言[未読]
【77796】Re:セルの結合→貼付け ぼぶ 15/12/23(水) 12:40 お礼[未読]

【77794】セルの結合→貼付け
質問  ぼぶ  - 15/12/23(水) 3:59 -

引用なし
パスワード
   初めて質問させていただきます。

Shee1に下記のような商品の管理表があります。
(実際のデータ行は100件以上あります)

 A     B         C
1選択    商品コード    商品名
2■    AA1111        リンゴ
3■    AA2222        バナナ
4□    AA3333        みかん
5■    AA4444        桃
6□    AA5555        メロン
7■    AA6666        イチゴ

A列が■になっている行の商品コードと商品名を合体(例:AA1111リンゴ)させて、
それをSheet2に貼り付けていくマクロを作りたいと思っています。

Sheet2はセルをA1:D8(1.)、E1:H8(2.)、A9:D16(3.)、E9:H16(4.)という風にそれぞれ結合したうえで、
1.2.3.4.の順番(Zを描くような動き)で貼り付けていきたいです。
(上記の例ですと、1.にAA1111リンゴ、2.にAA2222バナナ、3.にAA4444桃、4.にAA6666イチゴとなります)

また、初期状態ではA1:D8などのセルの結合はされていない真っ白な状態なので、
セルの結合⇒貼付け、セルの結合⇒貼付け…という動作が必要になります。

■になっている行の商品コードと商品名を合体させて取得するところまでは、
いろいろ参考にしながら下記のように書いたのですが、
それをSheet2に、セルを結合しながら、Zを描くような動きで貼り付ける動作が全く分からずとても困っています。
是非お力をお貸しください。よろしくお願いいたします。

-------------------------------------------------------
Sub harituke()
  Dim i As Range
  Dim lastrow As Long
  
  lastrow = Cells(Rows.Count, 1).End(xlUp).Row
  For Each i In Range("A2:A" & lastrow)
    code = i.Offset(0, 1).Value
    item = i.Offset(0, 2).Value
     If i = "■" Then
      ここにセル結合&貼付けの動作???
  End If
  Next i
  
End Sub

【77795】Re:セルの結合→貼付け
発言  γ  - 15/12/23(水) 6:19 -

引用なし
パスワード
   コードの一例です。

Sub harituke()
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim rng As Range
  Dim lastrow As Long
  Dim k As Long
  Dim r As Long
  Dim c As Long
  Dim code As String
  Dim item As String

  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets("Sheet2")

  r = 1 - 8  '転記先行番号初期値

  lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
  For Each rng In ws1.Range("A2:A" & lastrow)
    code = rng.Offset(0, 1).Value
    item = rng.Offset(0, 2).Value
    If rng.Value = "■" Then
      If k Mod 2 = 0 Then
        r = r + 8
        c = 1
      Else
        c = 5
      End If

      ws2.Cells(r, c).Value = code & item
      ws2.Cells(r, c).Resize(8, 4).Merge

      k = k + 1
    End If
  Next
End Sub

コメント:
(1)変数i は伝統的に、整数、とりわけループ変数に用いられるので、
  その慣習に従ったほうが違和感は少ないです。
  論理的には間違いとは言えないが、普通、こういうiの使い方はしません。
(2)セル結合が本当に必要か、よく検討したほうが良いです。
  セル結合するとあとあとの処理で色々な困難が待ち構えています。
  できれば避けるべきですね。
 

【77796】Re:セルの結合→貼付け
お礼  ぼぶ  - 15/12/23(水) 12:40 -

引用なし
パスワード
   γ様

ご回答ありがとうございます。

教えていただいた方法で希望していた通りに動作致しました。

VBAはまだまだ初心者で、1動作ずつ勉強しながら手さぐりで作成しているので、
また変数iの使い方や結合の問題などについてもアドバイス頂き、とても勉強になります!

セル結合については、Sheet2は印刷用のシートとして使う為、
レイアウト的な関係で結合することにしているのですが、
不具合が発生するようでしたら、γ様に教えていただいたコードを参考に、
自分なりに結合しないやり方を考えてみようと思います。

本当にありがとうございました!

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