セル解除後、各行に値をコピーし結合するマクロ

質問

A1からC3のセルが結合しており、
そのセル結合を解除すると、A列のみ値がコピーされる。

コピーした後、各行ごとにセルを結合していく……
という処理をしたいと思い、
調べて下記のマクロまでなんとかこぎつけました。

Sub セル結合()

Dim date1 As Variant
Dim range1 As Range

Application.DisplayAlerts = False
For Each range1 In Selection.Rows

If range1(1).MergeCells = False Then
range1(1).Merge

Else
date1 = Selection.Rows(1).Value

With range1
.UnMerge
.WrapText = False
.ShrinkToFit = False

Selection.Value = date1

End With

End If

Next range1

End Sub

※実行範囲に関しては、
　任意選択をした範囲にしたいため、
　range(1)にて処理を行いました。

困っているのは、上記のマクロを実行すると、
最初の行のみ結合できないということ。

もうひとつが、
セル結合をしない時に値を左端にコピーすると、
文字が自動縮小されてしまいます。
縮小しないようにするには、
どのような処理を入れたら良いでしょうか？

お力添え頂けますと幸いです。
よろしくおねがいします。

回答No.1

mt2008 · ベストアンサー

For Each の1行目の処理では行ごとのセル結合を行っていませんね。
For Each のループの中で結合解除から新たな行ごとのセル結合を行うのではなく、セル結合を解除した後でループを回して行ごとのセル結合を行った方が良いと思います。

> セル結合をしない時に値を左端にコピーすると、
> 文字が自動縮小されてしまいます。
これについては事象が良く判らないのでパスします。

Sub セル結合()
　　Dim date1 As Variant
　　Dim range1 As Range

　　Application.DisplayAlerts = False
　　With Selection
　　　　If .MergeCells = False Then Exit Sub
　　　　date1 = .Value
　　　　.UnMerge
　　　　.WrapText = False
　　　　.ShrinkToFit = False
　　End With　　
　　For Each range1 In Selection.Rows
　　　　range1.Merge
　　　　range1.Value = date1
　　Next range1
End Sub

お礼

ありがとうございます！
順番を違えていたのですね。
本当に助かりました。

もう一つのセルの自動縮小に関しても、
順番が違っていただけのようで、
変えてみたら無事に動きました。

ありがとうございます！

すみません。
一つ気になったのが、
セルを一つずつ選択しながら処理を進めていたのですが、
ワークシート上の結合セルを自動的に結合処理することも可能でしょうか？

範囲をSelectionから、ActiveWorksheetへ
変更するだけの処理かなと思ったのですが、
その記述が思いつきません…。

やはり新たに組み直して全く違う処理をしないと厳しいでしょうか。

質問のお答え頂いたにも関わらず、
再度質問をしてしまってすみません。

回答No.2

mt2008

> ワークシート上の結合セルを自動的に結合処理することも可能でしょうか？
シートの使用領域を全部見て行って結合セルか否かをチェックするしかないように思えます。
↓のサンプルは、先の回答の「セル結合」と合わせて使います。

Sub Sample()
　　Dim rTarget() As Range
　　Dim nCount As Long
　　Dim rWork As Range
　　For Each rWork In ActiveSheet.UsedRange
　　　　If rWork.MergeCells And (rWork.Address = rWork.MergeArea.Item(1).Address) Then
　　　　　　nCount = nCount + 1
　　　　　　ReDim Preserve rTarget(nCount)
　　　　　　Set rTarget(nCount) = rWork
　　　　End If
　　Next rWork
　　For i = 1 To nCount
　　　　rTarget(i).Select
　　　　Call セル結合
　　Next i
End Sub

お礼

これはすごいです！！！
シート内で使っている部分を確認して、
その後にcallで結合のマクロを使う方法もあるとは…
まだまだ勉強不足だなと思い知らされました。

本当にありがとうございます！！！
ReDim Preserveなど、私自身、初めて見るものも多く、
とても勉強になります。

提示していただいたマクロをしっかりと勉強させて頂き、
マクロのスキルをもっと深めていきます。

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