自動的にセルの結合

質問

はじめまして。

質問させていただくのは始めてなので失礼がありましたら指摘して下さい。

永年の疑問っていうかテーマなんですが、
結合されているセルを解除すると
一番左上のセルのみに元データがでるんですが、

これを、
全てのセルに自動的に入力することって出来ないでしょうか？

（　　　２　　　）（　　３　　）←結合されている
　　　　↓　　　　　　　↓
（２２２２２２２）（３３３３３）←自動的にこうしたい
※結合されているサイズはバラバラです。

今は、セルの解除をして一つずつオートフィルをすることで対応していますが、量が多いので自動でやれないかなと思っています。

逆に、同じセルが連続していた場合、自動的に結合することは可能ですか？

（２２２２２２２）（３３３３３）
　　　　↓　　　　　　　↓
（　　　２　　　）（　　３　　）

という様に。

よろしくお願いします！

回答No.4

imogasi · ベストアンサー

（１）セル結合を解除し、各セルに同一値をセット
Sub test01()
c = Val(InputBox("列を数字で＝"))
For i = 1 To 50
r = Cells(i, 1).MergeArea.Rows.Count
DoEvents
' MsgBox i & "行" & r
'--セル結合されているか
If r <> 1 Then
'--ｒ行がセル結合されている－－＞解除
Range(Cells(i, c), Cells(i + r - 1, c)).MergeCells = False
'--iからｒ行に同じ値をセット
For j = i To i + r - 1
Cells(j, c) = Cells(i, c)
Next j
i = i + r - 1
Else
End If
Next i
End Sub
セル結合されている対象とする１つの列を聞いてくるから、Ａ列は１、Ｂ列では２、・・と入力してください。
複数列あれば２度実行してください。
２列の結合は無いものとする。５０行まで。上記の５０を変えれば何行でも良い。
（２）同一値が縦に並んでおればセル結合する。
Sub test02()
Application.DisplayAlerts = False
c = Val(InputBox("列を数字で＝"))
'---初期設定
m = Cells(1, c)
s = 1
r = 1
'-----第２行から５０行まで
For i = 2 To 50
If Cells(i, c) = m Then
'--i行が直前セルと同じ
r = r + 1
Else
If r <> 1 Then
If Cells(s, c) <> "" Then
Range(Cells(s, c), Cells(i - 1, c)).MergeCells = True
End If
s = i
r = 1
End If
End If
m = Cells(i, c)
Next i
Application.DisplayAlerts = True
End Sub

お礼

マクロ知識のあまりない私にも成功しました！
これで、すっごく楽になるんです。
特に、（２）はかなり役立つことになりそうです。
ありがとうございます。

感動しました。

回答No.3

KenKen_SP

#2 の補足です。セルの選択範囲内に、結合セルや結合されていないセルが混在していても構いません。また、数も制限がありません。

＞＞逆に、同じセルが連続していた場合、自動的に結合することは可能ですか？

＞普通に連続セルを選択して、普通に結合するだけできますよ。

読み返して、私が勘違いしていることに気付きました。
「シート内の値が連続している範囲を自動的に結合する」ということでしょうか？

そうであれば、諦めた方が良いと思います。VBAでやれなくはないでしょうが、できたとしても、処理に時間がかかりすぎて、恐らく使い物にならないでしょう。

回答No.2

KenKen_SP

こんにちは。

以前作成したマクロです。
セルの選択範囲内にある、結合されたセルだけを分割し、データで埋めます。
セルの選択範囲内の結合されていないセルに対しては、なにもしません。
ご参考までに。

'セル結合を解除し,データで埋める
Sub unMergeCell()

　　Dim myRng As Range
　　Dim iCell As Range
　　Dim BUF As Variant

　　On Error GoTo ErrorHandler
　　Application.ScreenUpdating = False

　　Set myRng = Selection
　　For Each iCell In myRng
　　　　With iCell
　　　　　　.Select
　　　　　　If .MergeCells Then
　　　　　　　　BUF = .Value
　　　　　　　　.MergeCells = False
　　　　　　　　Selection.Value = BUF
　　　　　　End If
　　　　End With
　　Next iCell

ErrorHandler:
　　Set myRng = Nothing
　　Application.ScreenUpdating = True

End Sub

＞逆に、同じセルが連続していた場合、自動的に結合することは可能ですか？

普通に連続セルを選択して、普通に結合するだけできますよ。

お礼

ありがとうございます！！
マクロの知識はまだまだないのですが、
ない私にもしっかり活用するできました。

回答No.1

BLUEPIXY

とりあえず、１つの結合されたセルを分解するヤツを作ってみました。
結合されているセルをクリックしてマクロ実行を呼び出します。
Public Sub 分解()
Dim r As Range, x As Range, v
Set r = Application.Selection
v = ActiveCell.Formula
r.UnMerge
For Each x In r
x.Formula = v
Next
End Sub
でたらめな範囲を指定して、その中にある結合された部分をやることもできるとは思いますが、省略。
繰りかえし実行する時はCTRL+Yで。

逆に、結合するのもできると思いますが、同じくでたらめな範囲から結合する部分を切り出すのが面倒なので省略。

お礼

ありがとうございます。成功しました！

ですが、、、もう少し自動的な感じはできないですかねぇ。。。
でたらめな範囲になると急に難しくなるんですか？