エクセルで結合セルの内容を解除した各セルに転記する

質問

いつも大変お世話になっております。

過去にも同じ要求があり、何度か手作業で対処してきたのですが、今回は表が大きいので何とかならないかと。

具体的には特定の列（例えばA列）が3行から6行の接合セルになっている表で、A列の結合を解除したときにA１：A5、A６：A7と言った不規則に結合されている行の結合セルの内容を、結合を解除したときに各セルに転記したいのですが関数では無理なようで、当方のVBAの知識では解決できないのでどなたかお助けください。

尚、シート全体の結合セルを対象にするとまずいので、解除対象の列は指定した列のみで動くことが必要です。
複数列の結合列の解除の場合は、複数回に分けての実行もOKです。

回答No.8

kkkkkm · ベストアンサー

No.7の追加です。

数式だった場合に同じ数式にしたい場合は
(No.7でもこちらに変更しても数式以外はそのままの値が記載されます)

Dim tmp As Variant
Dim i As Long

を追加して

'セル結合を解除
A.UnMerge
'セル結合されていた範囲に値を入力
B.Formula = A.Formula '元のコードのValueをFormulaに変更

の部分を

tmp = A.Formula
'セル結合を解除
A.UnMerge
'セル結合されていた範囲に値を入力
Debug.Print B.Rows.Count
For i = 1 To B.Rows.Count
B.Cells(i, 1).Formula = tmp
Next

に変更してください

お礼

補足のご回答感謝です。
当方も後知恵で、関数もあり得ることに気付きました。

補足しようかと思っていたら、すでに補足頂いていました。
関数でもしっかり期待通りに動くことを確認いたしました。

これで完全形だと思います。
ありがとうございました。

回答No.7

kkkkkm

1列でも複数列でも選択列が離れていても選択されている列を対象にします。
列全体でなくセルを選択していてもその列が対象になります。
数式だった場合は数式のコピーをした時と同じ動作になると思います。
同じ値を入力する部分は
回答No.3の参考先にあるコードを利用しています。

Sub Test()
Dim FRng As Range
Dim mCol As Range
Dim A As Range, B As Range

For Each mCol In Selection.Columns
Set FRng = Range(Cells(1, mCol.Column), Cells(Rows.Count, mCol.Column).End(xlUp))

'回答No.3の参考先にあるコードを利用
'データをループ
For Each A In FRng
'セル結合されている場合
If A.MergeCells Then
'セル結合の範囲を保存
Set B = A.MergeArea
'セル結合を解除
A.UnMerge
'セル結合されていた範囲に値を入力
B.Formula = A.Formula '元のコードのValueをFormulaに変更
End If
Next
'参考ここまで

Next

End Sub

お礼

ご回答ありがとうございます。

選択列を対象に、複数列でも動くことは質問内容にないにもかかわらず忖度頂き非常に助かります。

回答No.6

SI299792

Ａ列と書いてあったので、Ａ列にしました。
定数の入っている所が対象です。空白や関数は対象外になります。
Option Explicit
'
Sub Macro1()
　　Dim Cell As Range
　　Dim Area As Range
'
　　For Each Cell In [A:A].SpecialCells(xlCellTypeConstants)
'
　　　　If Cell.MergeCells Then
　　　　　　Set Area = Cell.MergeArea
　　　　　　Area.UnMerge
　　　　　　Area = Cell
　　　　End If
　　Next Cell
End Sub

お礼

お礼が遅くなり申し訳ありません。
いつもお世話になっております。

ご回答ありがとうございます。
しかし、同時に列選択（複数列でも可）というご回答を頂きましたのでこちらをBSにさせて頂きますのでご了承ください。

質問には「選択列で、複数列でも動く」とは記載されていない条件なので申しわけありません。

回答No.5

imogasi

#4です。VBAコードの１例を示します。
Sub test01()
For Each cl In Range("A1:D15")
If cl.MergeCells Then 'sがいる
adrs = cl.MergeArea.Address
Set mrng = Range(adrs)
mrng.Select
'MsgBox "A"
v = cl.MergeArea.Item(1).Value '左上隅セルの値
mrng.UnMerge
For Each mcl In Selection.Cells '.Cells必要
'MsgBox mcl.Address
mcl.Value = v
Next mcl
End If
Next cl
End Sub
ーー
Range("A1:D15")のセル範囲は適当に変えてください。
また、例えば、A1：A4セルに付いて、元はa、ｂ、ｃ、dでも、a,△、ｃ、dでも,
結果は,a,a,a,ａにならざるを得ません、ので注意。

回答No.4

imogasi

操作が手間なら、VBA利用しかないだろう。
ーー
下記のような難しさがある（VBAの中級以上か）が、あえてVBAでやりますか？
色々理解しておいた上で、でないと使用は危険だと思うが。
複数列にまたがるセル結合があれば、なお複雑になる。
＝＝＝＝
質問を具体的な１例で表現したら、分かりやすいと思う。
＞A１：A5、A６：A7・・
の例で言えば、A１セルに、「aaa」という値が入っているとする。
値が入っている見た目はA1:A5の表示形式で設定の場所（配置）に見えて居る。
しかし
Sub test01()
MsgBox Range("A1").Value
MsgBox Range("A2").Value
MsgBox Range("A3").Value
MsgBox Range("A4").Value
MsgBox Range("A5").Value
End Sub
を実行では、A1を指定した文だけ「aaa」が表示されて、他はエラーにならないが、何も表示されない。でもA2:A5セルが、シートのセルの仕組みとしては、なくなってはいない。
それと結合セルがあるかどうかを、問題にする範囲は、一度に指定しやすいが、結合セル範囲だけを、個別に返す（指定してくれる）ＶＢＡの仕組はない。
だからセル範囲の、１セルづつを調べる必要がある。そして左上隅のセルに当たるセルは、cl.MergeArea.Item(1)で捉えられる。
でも範囲内の各セルを総なめにして（結合）チェックしているときに、下手なタイミングで、セル結合を解くと、処理の流れを乱す。でもセル結合を解かないと、そのセルに値を設定できない。
Sub test13()
Range("A1").UnMerge
MsgBox Range("A1").Value
MsgBox Range("A2").Value
MsgBox Range("A3").Value
MsgBox Range("A4").Value
MsgBox Range("A5").Value
End Sub
で行われる処理結果で良いのか？
質問の説明では、
＝＝＝＝＝
＞各セルに転記したいのですが
上の例で言えば、A2:A5も、「aaa]を入れたいのか？
結構ややこしい処理になる。
Sub test14()
Range("a2").Value = "aaa"
MsgBox Range("A2")
End Sub
は（A1:A5セル結合下で）エラーにならないが、値は設定されない。
このように複雑なのである。
ーー
＞複数列の結合列の解除の場合は、複数回に分けての実行もOKです。
プログラムで処理するのであれば、こんなことを断ってもらっても、足しにならない。

お礼

ご回答ありがとうございました。

＞色々理解しておいた上で、でないと使用は危険だと思うが。
複数列にまたがるセル結合があれば、なお複雑になる。

当方には上記ご指摘の解決は無理かと。

回答No.3

kon555

こちらのページの『if関数を使用する』のパターンが参考になると思います。
https://daitaideit.com/vba-unmerge-and-input-data/

お礼

お礼が遅くなりました。

ご回答の関数は当方にも分かり易く早々に試して（見るまでもなく）うまく行きました。

とりあえずはこれは使える発想で非常に参考になりました。