同じ値のセルを自動で結合するマクロ（vba）

☆手作業でもできますが・・・

　エクセルはセルの結合をするとカットアンドペーストや並べ替えなどが不自由になるので、セルの結合はしない方が良いと言われています。
一方で、並べ替えなどが確定し、印刷する段階で見やすさを求めるため、「同じ内容のセルを結合したものを印刷して欲しい」と言うニーズは良くあります。
セルの結合は、マウス操作で可能ですが、結合する数が多い場合や、何度も内容が変わり結合するセルも変わる場合はかなりの時間を要します。
　そこで、エクセルのマクロを作りました。

☆このマクロでできること

　エクセルの画面の様子ですと次の通りです。

→　実行　→

　

上下方向で同じ内容のセルが連続であれば、同じセルが何個あるか確認して一つに結合します。

☆使い方

　下に掲載したコードをコピーして、
結合したいシートがあるご自身のファイルを開き、マクロのウィンドウでコードをペーストしてください。

☆コード

Sub 上下同じ値のセルを結合()

Dim gyou, retu As Long 'カーソルがあるせるの行= gyou､列= retu
Dim rng As Range '結合時に使う範囲を入れる変数　= rng
Dim onaji As Integer '同じセルの個数を入れる変数　= onaji

Application.DisplayAlerts = False '結合時のダイアログ省略

gyou = ActiveCell.Row
retu = ActiveCell.Column 'スタートセルは、現在カーソルがあるセル

Do Until Cells(gyou, retu).Value = "" '空白セルがあるところまで上から順に調べる

Set rng = Cells(gyou, retu) '調べるセルを rng に代入する
With Cells(gyou, retu)

onaji = 1
Do While .Value = .Offset(onaji, 0).Value 'セル値が上下で同じか判定

onaji = onaji + 1 '同じ値のセルの個数カウント

Loop
If onaji >= 2 Then '同じ値のセルが2つ以上で結合

Range(Cells(gyou, retu), Cells(gyou + onaji - 1, retu)).Merge
　　　　　 'offsetの基準セルは+0個目、一つ下は+1個目　そのためonajiから1を引く

End If 'セルを結合

End With
gyou = gyou + onaji '結合すると空白セルになるので、
'同じセルだった分をgyouに加算して次へ

Loop
Application.DisplayAlerts = False '結合時のダイアログ復活

End Sub

☆参考文献

(1) EXCELマクロ＆VBAプロ技セレクション　技術評論社

←戻る