エクセル2007 同一データが連続したセルの結合について

質問

はじめて投稿させていただきます。
うまく説明できるかどうか判りませんが、よろしくお願いします。
エクセル2007 で以下のような結果を得られるようなマクロを作りたいと考えています。
横方向にＡ列～Ｃ列の３つの連続したセル内容が同一で縦方向に２つ以上連続した場合のみ、それらの行を結合させたいのです。具体的には下図のような感じです。
何かよい方法があればアドバイスいただきたいと思います。どうかよろしくお願いします。

Ａ列　　　　　Ｂ列　　　　　Ｃ列　　　　　Ｄ列
機種　　　　　区分　　　　ユーザー名　　　納品数

ABC　　　　　あああ　　　　田中商店　　　　10
ABC　　　　　あああ　　　　田中商店　　　　20
ABC　　　　　あああ　　　　田中商店　　　　30
XYZ　　　　　 いいい　　　　田中商店　　　　25
XYZ　　　　　 ううう　　　　 山田商事　　　　40

　　　　　　　↓　↓　↓　↓　↓

Ａ列　　　　　Ｂ列　　　　　Ｃ列　　　　　Ｄ列
機種　　　　　区分　　　　ユーザー名　　　納品数

　　　　　　　　　　　　　　　　　　　　　　　　　　 10
ABC　　　　　あああ　　　　田中商店　　　　20
　　　　　　　　　　　　　　　　　 　　　　　　　　　30
XYZ　　　　　いいい　　　　田中商店　　　　25
XYZ　　　　　ううう　　　　 山田商事　　　　40

回答No.1

KURUMITO · ベストアンサー

エクセルは表計算ソフトです。見た目よりも機能がよく働くように維持することが必要でしょう。その点でセルの結合はそのあとの計算処理を複雑にします。できればセルの結合はしないことですね。
どうしてもということであれば次のようなマクロはどうでしょう。
結合のときに注意が表示されますがＯＫすればよいでしょう。
Sub セルの結合()
Dim i As Integer
Dim n As Integer
Application.ScreenUpdating = False
i = 0
Do
i = i + 1
If Range("A" & i) & Range("B" & i) & Range("C" & i) = Range("A" & i + 1) & Range("B" & i + 1) & Range("C" & i + 1) Then
n = 0
Do
n = n + 1
Loop Until Range("A" & i) & Range("B" & i) & Range("C" & i) <> Range("A" & i + n) & Range("B" & i + n) & Range("C" & i + n)
Range(Range("A" & i), Range("A" & n - 1 + i)).MergeCells = True
Range(Range("B" & i), Range("B" & n - 1 + i)).MergeCells = True
Range(Range("C" & i), Range("C" & n - 1 + i)).MergeCells = True
i = n - 1 + i
End If
Loop While i < Range("a65536").End(xlUp).Row
Application.ScreenUpdating = True
End Sub

お礼

早々に回答いただきありがとうございます。
おっしゃるように、マクロを実行すると、「選択範囲には複数のデータがあります。１つのセルとして結合すると・・・」と警告画面が表示され、「ＯＫ」ボタンを押すことによりセルは結合され、思ったような表示になります。しかし、シート中にセルの結合されるべき部分が数百個所あるため、その数と同じ回数だけ警告画面があらわれます。
ただ単にデータが入ったセル複数を選んで「セルを選んで中央揃え」ボタンを押しても同様の警告が出るので、当然といえば当然なのでしょうが・・。やはり、私のやろうとしていることには無理があるのでしょうか？

回答No.4

takana_

#3です
仮にセルE2でも
=CONCATENATE($A1,$B1,$C1)
と入力してみてください
なんとなく関数の意味はわかると思います。

条件式の意味は
=CONCATENATE($A1,$B1,$C1)　と
=CONCATENATE($A2,$B2,$C2)　の
返す答えが等しければ（Trueであれば）、設定した書式を適用しろということです。
仮に適当なセルに、=1=1 分かりやすく書けば=(1=1)と入力すればTRUEとなるはずです。1と1は等しいということです。

お礼

いろいろありがとうございます。
これから色々勉強していきたいと思います。

回答No.3

takana_

望まれているやり方とは少し違いますが、
このような方法はどうでしょうか？

A2セルを選択して
条件付き書式を選択して
「ルールの種類」で、「数式を使用して書式設定する」を選択
「ルールの内容に」以下の数式を記述
=CONCATENATE($A1,$B1,$C1)=CONCATENATE($A2,$B2,$C2)
「書式の選択」で「フォントの色」に白色を選択
A2セルをコピーして、A2:C6セルに「形式を選択して貼り付け」
において「書式」を貼り付ける。

以上で、見た目はフォントが白色なので見えなくなります。

お礼

ありがとうございます。
こんな方法もあったのですね！勉強になります。
これだとセルの結合をしなくても済むんですね。
ただこれは何を意味するんでしょうか？

＞　=CONCATENATE($A1,$B1,$C1)=CONCATENATE($A2,$B2,$C2)

回答No.2

yucco_chan

>その数と同じ回数だけ警告画面があらわれます

＃１さんのソースを流用して、以下のように
Application.DisplayAlerts = False　を付け加えれば、警告メッセージが出ません。
＃１さんが言われるように、私もセルの結合は推奨しませんが。。

Sub セルの結合()
Dim i As Integer
Dim n As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False

i = 0
Do
i = i + 1
　　If Range("A" & i) & Range("B" & i) & Range("C" & i) = Range("A" & i + 1) & Range("B" & i + 1) & Range("C" & i + 1) Then
　　n = 0
　　Do
　　　　n = n + 1
　　Loop Until Range("A" & i) & Range("B" & i) & Range("C" & i) <> Range("A" & i + n) & Range("B" & i + n) & Range("C" & i + n)
　　Range(Range("A" & i), Range("A" & n - 1 + i)).MergeCells = True
　　Range(Range("B" & i), Range("B" & n - 1 + i)).MergeCells = True
　　Range(Range("C" & i), Range("C" & n - 1 + i)).MergeCells = True
　　i = n - 1 + i
　　End If
Loop While i < Range("a65536").End(xlUp).Row
Application.ScreenUpdating = True
End Sub

お礼

ありがとうございました。
おかげさまで、警告画面がスキップされ、思うような結果が得られました。
私の場合、仕事上、97列、約600行のcsvファイルをダウンロードして、そこから不要な列を削除、社員に視覚的にわかりやすくして配布する必要があったので、重複内容のセル結合にこだわったのです。後々、表計算に利用する必要も無かったものですから。
このたびは本当にお世話になり、ありがとうございました。