[[20120508173852]]　『セルの結合(横)について』（白猫）　ページの最後に飛ぶ

『セルの結合(横)について』（白猫）

皆様

こんにちは。
セルの結合を自動的に行いたいのですが、困っていることがあります。
すみませんが、ご教授いただけますでしょうか。

<Excelバージョン>
2003

<Excelでの作成資料>

日程表を作成するにあたり、1行目に年/月(例：2012/05)を表示し、
2行目に日付(例：07)を表示しています。
年/月の取得には、「TEXT(B2,"yyyy/mm")」を使用しています。

<実施したいこと>

1行目の年/月が隣のセルと同じ場合、セルの結合。
隣のセルと違う場合、何もしない。

<イメージ>

______________________________
|2012/05 |2012/06 |
|______________|______________|
|01|02|03|04|05|01|02|03|04|05|
|__|__|__|__|__|__|__|__|__|__|

<困っていること>

下記のスクリプトを実行したところ、1回実行するごとにセルの結合が1つ
出来るのですが、1回の実行で全てのセルに対して処理が実施されません。

例えば、B1、B2、B3、B4に同じ「2012/05」が入っていた場合、
1度実行すると、B1 とB2はセルの結合がされるのですが、B3はされません。
もう1度実行するとB3はB1&B2セルと結合されるのですが、B4は結合されません。

<実施したいこと>

B1、B2、B3、B4に「2012/05」が入っており、
B5、B6、B7に「2012/06」が入っていた場合、
1度の実行で、B1～B4 とB5～B7が結合されるようにしたい。

<作成スクリプト>

=====================
Sub cellunion()

  Dim cu1 As Range
  Dim cu2 As Range

  Set cu1 = Range("B1")

  Do Until cu1.Value = ""
   Set cu2 = cu1.Offset(0, 1)
   If cu2.Value <> cu1.Value Then
   Else
    Application.DisplayAlerts = False
    Range(cu1, cu2).Merge
    Application.DisplayAlerts = True
    Set cu1 = cu2
   End If
  Loop

End Sub
=====================

すみませんが、どなたか良い方法を教えていただけますでしょうか。

 たとえば

 Sub Sample()
    Dim f As Range
    Dim c As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set f = Range("A1")
    For Each c In Range("B1", Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)) '１行目をB1からデータ最終セルの次のセルまで
        If c.Value <> f.Value Then  '前のセルと値が異なれば、前のセルまでを結合
            Range(f, c.Offset(, -1)).Merge 'Merge
            Set f = c
        End If
    Next
    Set f = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "処理が完了しました"

 End Sub

 追記）　１行目を｢横に｣結合したけど、それでいいんだよね？
　　説明文の中では、B1～B4 等 ｢縦｣の結合という表現も混在しているけど。

 (ぶらっと)

ぶらっとさん

早速のご回答、ありがとうございます。
ご連絡いただいた方法でやりたいことが出来ました！
本当にありがとうございました。

PS.B1～B4など、間違ったことを記載してしまい、すみませんでした。

コメント返信：

[ 一覧(最新更新順) ]

[[20120508173852]] 『セルの結合(横)について』（白猫） ページの最後に飛ぶ

[[20120508173852]]　『セルの結合(横)について』（白猫）　ページの最後に飛ぶ