Excel。VBA。結合セルのあるデータを結合セルで並べ替えるにはどうしたいい。
＜Excel VBA＞
Excelを、帳票のように使うのと、データベースのルールに基づいて使うのでは、Excelの機能を有効に使える使えないということがあります。
特にやりがちなのが、「セルの結合」。
例えば次の表で説明していきます。
A列は、A2:A5までセルの結合をされています。
このように、A列は、複数のデータをまとめてある状態です。
このようなセルの結合の帳票はよく見かけます。
見た目はいいのですが、店舗名を五十音順で並べ替えを行いたいとすると、メッセージが表示されて実行することができません。
店舗名で並べ替えをおこなうには、セルの結合を解除します。
解除すると空白セルになっているので、並べ替えを実行できないので、該当する店舗名を入力あるいは、コピーする作業をおこない、その後、店舗名を五十音順で並べ替えをしたあとに、再度、セルの結合を行うという、ハッキリいって、「やりたくない」作業ですね。
ただただ面倒。
そこで、Excel VBAでプログラムを作って処理をさせるのがいいかと思います。
そのExcel VBAのプログラム文です。
Sub セル結合解除()
Dim i As Long
Dim j As Long
Dim start As Long
Dim lastrow As Long
Application.ScreenUpdating = False '画面がひんぱんに切り替わるのを止める
Application.DisplayAlerts = False '確認メッセージを非表示にする
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
For i = 2 To lastrow
Cells(i, "a").UnMerge
Next
For i = 2 To lastrow
If Cells(i + 1, "a") = "" Then
If lastrow <= i + 1 Then
Exit For
Else
Cells(i + 1, "a").Value = Cells(i, "a")
Cells(i + 1, "a").SetPhonetic
End If
End If
Next
With Range("a1").CurrentRegion
.Sort key1:="店舗名", order1:=xlAscending, Header:=xlYes
End With
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
j = 0
start = 2
For i = 2 To lastrow
If Cells(i + 1, "a") = Cells(i, "a") Then
j = j + 1
Else
Range(Cells(start, "a"), Cells(start + j, "a")).Merge
start = i + 1
j = 0
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
ちょっと長いですが、実行してみましょう。
このように、店舗名はセルの結合をしてある状態で、五十音順で並べ替えが実行されています。
結合するセルの数が異なっていても、対応しています。
では、プログラム文を説明していきます。
お馴染みの変数宣言からです。使うところで、何に使用しているのか説明します。
Dim i As Long
Dim j As Long
Dim start As Long
Dim lastrow As Long
次の2行は、入れておくと便利な2行です。
Application.ScreenUpdating = False '画面がひんぱんに切り替わるのを止める
Application.DisplayAlerts = False '確認メッセージを非表示にする
Application.ScreenUpdating = False は、画面がひんぱんに切り替わるのを止めるとめもしてありますが、並べ替えを実行したり、空白のセルにデータをコピーしたりするので、この行を入れておきます。
Falseにすることで、作業が画面表示されないので、処理が早くなります。
Application.DisplayAlerts = False は、確認メッセージを非表示にする とメモをいれていますが、セルの結合を解除したり、セルの結合を再度行う時に、いちいちメッセージが表示され、ボタンを押さないと実行しないというのは、面倒なので、Falseを設定することで、メッセージを非表示にすることができます。
データの最終行番号を取得するのが次の行。
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
この行番号まで繰り返し処理をさせます。
このFor To Next文は、セルの結合を解除させています。
For i = 2 To lastrow
Cells(i, "a").UnMerge
Next
「UnMergeメソッド」でセルの結合を解除することができます。
2つ目のFor To Next文は、セルの結合を解除したあとの処理です。
For i = 2 To lastrow
If Cells(i + 1, "a") = "" Then
If lastrow <= i + 1 Then
Exit For
Else
Cells(i + 1, "a").Value = Cells(i, "a")
Cells(i + 1, "a").SetPhonetic
End If
End If
Next
やっている処理は、なんなのかというと、セルの結合を解除したので、セルの結合されていた一番上のセルにしかデータ（店舗名）がありません。
空白のセルに店舗名を入力（コピー）しています。
このあとに、五十音順に並べ替えをするのですが、入力文字情報が欠落しているので、フリガナ情報もいれています。
また、最終行ならば、For文を抜ける作業をさせています。
ちょっと細かく見ていきます。
次のセルの値が空白だったら、次の処理をします。
さらに、If文で条件分岐させています。
If Cells(i + 1, "a") = "" Then
この文は、次のセルが空白かどうか、確認するための文です。
If lastrow <= i + 1 Then
Exit For
Else
最終行ならば、「Exit For」。For文を抜けるという命令をしています。
Cells(i + 1, "a").Value = Cells(i, "a")
この文は、空白セルに、店舗名を入力する作業を行っています。
Cells(i + 1, "a").SetPhonetic
入力した店舗名には、フリガナ情報がないので、「SetPhoneticメソッド」で入力文字情報を追加しています。
この情報をいれないと、綺麗に五十音順で並べ替えを行うことができません。
With文は、店舗名を五十音順で並べ替えを行っています。
With Range("a1").CurrentRegion
.Sort key1:="店舗名", order1:=xlAscending, Header:=xlYes
End With
A1から連続（CurrentRegion）している範囲を、店舗名を基準(key1)で、五十音順（昇順: xlAscending）とします。また、一行目を見出し行（Header:=xlYes）とするので、それを除き、並べ替える（Sort）ということをしています。
並べ替えが終わったので、再度、セルの結合を行います。
For i = 2 To lastrow
If Cells(i + 1, "a") = Cells(i, "a") Then
j = j + 1
Else
Range(Cells(start, "a"), Cells(start + j, "a")).Merge
start = i + 1
j = 0
End If
Next
If文の真の処理は、次のセルのデータも同じだったら、結合するセル数をカウントしています。
偽の処理は、セルの接合の処理をしています。
startという変数は、セル結合の先頭の行番号をいれています。
その行番号に同じ店舗名の件数が代入している、変数Jを足したものを範囲として、セルの結合をしています。
このような流れで処理をすることで、セルの結合してあるデータの並べ替えを行ってみました。
本来は、データベースの考え方で、セルの結合は行わず、レコードとしてすべてのセルにデータを入力してほしいところですね。
