結合されたセルの移動 ＶＢＡ

質問

「結合されたセルの一部を変更することはできません」と言うメッセージイベントでＶＢＡを実行するにはどうしたらよいでしょうか？

結合されたセルあるいは複数の結合されたセルを選んで移動する場合、移動先が自分のセルに重なると、「結合されたセルの一部を変更することはできません」と言うメッセージが現れます。
これを回避するには一旦何も無い離れたところに移動し、それから再び目的の場所に移動します。
私の技能では以下のようなマクロになると思います。
最初に元の結合セルを選び、場所を覚えるマクロを実行しする。
次に移動先を指定し、「一旦何も無い離れたところに移動し、それから再び目的の場所に移動」するマクロを実行します。
これをワン・アクションで、「結合されたセルの一部を変更することはできません」と言うメッセージが出るタイミングで実行するにはどうしたらよいでしょうか。
よろしくお願い申し上げます。

回答No.6

onlyrom · ベストアンサー

未使用のセルに移して処理するのならエラー云々は関係ないのでは？
で、簡単なサンプルを。
一時的に利用する未使用セルを質問と同じ　A50000以降とする。

-------------------------------------------------
'（Ctrl+a）

Sub 場所の記憶()
　Selection.Cut Destination:=Range("A50000")
End Sub
---------------------------------------------------------

'（Ctrl+b）

Sub 特殊貼り付け()
　　Range("A50000").CurrentRegion.Cut Destination:=ActiveCell
End Sub
-------------------------------------------------

（１）場所の記憶「Ctl+a」で無条件に選択範囲を使われていないA50000からに移動
（２）次に移動先のセルを選択
（３）特殊貼り付け「Ctl+b」でActiveCellに貼り付け

以上。

お礼

回答ありがとうございます。
通常のカット＆ペーストの動作に準じた動きを想定して
いましたが、割り切って考えると、この簡単なマクロで十分ですね。

補足

最初に選択してから、実行しない場合もあり得るので「Selection.Cut Destination:=Range("A50000")」は二つ目のマクロに入れました。
移動先が元のセルの底辺より低い位置の場合、移動先の左上ではなく左したとすることで、どこへでも移動できるようにしました。
皆様のおかげでなんとか実用的なマクロを作ることができました。
ありがとうございました。

Option Explicit

Public Pr1 As Long
Public Pr2 As Long
Public Pr3 As Long
Public Pc1 As Long
Public Pc2 As Long
Public Pc3 As Long

Sub 場所の記憶()
　　Pr1 = Selection.Row
　　Pr2 = Selection.Rows.Count
　　Pc1 = Selection.Column
　　Pc2 = Selection.Columns.Count
　　Pr3 = Pr1 + Pr2 - 1
　　Pc3 = Pc1 + Pc2 - 1
　　Selection.Copy 'ここではコピーしないが、選択範囲を表示する為に行う
End Sub

Sub 特殊貼り付け()
　　Dim r1 As Long
　　Dim r2 As Long
　　Dim r3 As Long
　　Dim c1 As Long
　　Dim c2 As Long
　　Dim c3 As Long

　　If (Pr1 = 0) Or (Pr2 = 0) Or (Pc1 = 0) Or (Pc2 = 0) Then
　　　　MsgBox "先に位置の指定を行ってください"
　　　　Exit Sub
　　End If

　　r1 = Selection.Row
　　c1 = Selection.Column
　　If r1 > Pr3 Then
　　　　r3 = r1
　　　　r1 = r3 - Pr2 + 1
　　Else
　　　　r3 = r1 + Pr2 - 1
　　End If
　　c3 = c1 + Pc2 - 1
　　Range(Cells(Pr1, Pc1), Cells(Pr3, Pc3)).Select
　　Selection.Cut Destination:=Range("A50000")
　　Range(Cells(r1, c1), Cells(r3, c3)).Select
　　Range("A50000").CurrentRegion.Cut Destination:=ActiveCell
　　Application.CutCopyMode = False
End Sub

回答No.5

imogasi

#3です。
ご質問の趣旨を私が誤解ー＞使えない　ということのようですが、
あるセルを選択、または注目したとき、被結合セルの判別ができれば
、その際あるモジュールを実行するなり何なりできると思って、
コードの有効性をテストしてコードまで挙げました。
そのアイデアは（１）ＭｅｒｇｅＣｅｌｌｓプロパティがＴｒｕｅでかつ
（２）基準セルが自分の番地と違うという判定です。
これでは、質問のケースでは使えないの課も知れませんが、セルの
選択をする場合（ＳｅｌｅｃｔｉｏｎＣｈａｎｇｅ）などなら
選択した瞬間に上記判別に入れば、役立つような気がしてました。
役立たないのなら、残念ですが、＃３は無視してください。
＞最初に元の結合セルを選び、場所を覚えるマクロを実行しする。
こういう「覚えておく」式のロジックは一般に避けたほうが良いと思う。
＞次に移動先を指定し、「一旦何も無い離れたところに移動し、それから再び目的の場所に移動」するマクロを実行します。
これをワン・アクションで、「結合されたセルの一部を変更することはできません」と言うメッセージが出るタイミングで実行するにはどうしたらよいでしょうか
この意味は、被結合セルを指定されたら、結合セルを強制的に選択してしまうということですか？表現がわかりにくい。もう一歩自分のプログラムロジックは置いておいて、したいケースを文章に表現したらどうですか。

補足

どうもマウスだけのワン・アクションでは無理なような気がして、以下のVBAを作ってみました。
Sub 場所の記憶()にCtr-aを、Sub 特殊貼り付け()にはCtr-bを割付けました。
元の場所を選んでCtr-aで記憶させ、移動先を選らんでCtr-bを押して貼り付けることができました。
但し上方方向だけで、下方方向は選択した場所が結合セルの右上になっているので重ねることはできません。左下のセルが先頭になるような貼り付けマクロをもう一つ作ればできると思います。

Option Explicit

Public Pr1 As Long
Public Pr2 As Long
Public Pr3 As Long
Public Pc1 As Long
Public Pc2 As Long
Public Pc3 As Long

Sub 場所の記憶()
Pr1 = Selection.Row
Pr2 = Selection.Rows.Count
Pc1 = Selection.Column
Pc2 = Selection.Columns.Count
Pr3 = Pr1 + Pr2 - 1
Pc3 = Pc1 + Pc2 - 1
Selection.Copy 'ここではコピーしないが、選択範囲を表示する為に行う
End Sub

Sub 特殊貼り付け()
Dim r1 As Long
Dim r2 As Long
Dim r3 As Long
Dim c1 As Long
Dim c2 As Long
Dim c3 As Long

r1 = Selection.Row
c1 = Selection.Column
r3 = r1 + Pr2 - 1
c3 = c1 + Pc2 - 1

Range(Cells(Pr1, Pc1), Cells(Pr3, Pc3)).Select
Selection.Cut
Cells(50000, 1).Select '多分ここら辺は使われていないだろう
ActiveSheet.Paste
If Cells(r1, c1).MergeCells Then
Cells(r1, c1).UnMerge
End If
If Cells(r1, c3).MergeCells Then
Cells(r1, c3).UnMerge
End If
If Cells(r3, c1).MergeCells Then
Cells(r3, c1).UnMerge
End If
If Cells(r3, c3).MergeCells Then
Cells(r3, c3).UnMerge
End If
Cells(50000, 1).Select
Selection.Cut
Range(Cells(r1, c1), Cells(r3, c3)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

回答No.4

Ce_faci

No２です
そうですか
>メッセージが出るタイミングで実行するにはどう…
プログラムを同時に実行することは出来ないものと考えております。
エラーメッセージ「結合されたセルの一部を変更することはできません」は、
コピーを試みた。
が、出来なかった。
メッセージでお知らせ。
の順を踏んでいると考えております。
おやりになりたい作業マクロはメッセージの出る前でしょうか、あとでしょうか？
前者の場合でしたら、セルのプロパティがどうなっているのかを調べてから、作業することになると思われます。
私は後者の場合で考えました。もっとも、私が添えたMsgboxは、マクロ実行で何も結果が確認できないのはどうかと考えて付けたものでございますが、見方を変えればMsgboxがエラーメッセージの表示と変わらないと考えます。その場合、Callの行は削除になり、MsgboxにSetステートメントを用いて次のマクロをご用意されるといいかと存じます。

回答No.3

imogasi

Ａ１：Ａ１０でＡ３：Ａ５とＡ８：Ａ９をセル結合して、下記を実行すると、被併合セルである、４，５および９が表示された。これを生かせないでしょうか。
Sub merg1()
For i = 1 To 10
Cells(i, "A").Activate
If Cells(i, "A").MergeCells = True And ActiveCell.Address <> Cells(i, "A").Address Then
MsgBox i
End If
Next i
End Sub
がエラーなく動きました。
被結合セルのプロパテイと結合セル（基準セル）プロパテイがＶＢＡにないみたいなので、苦肉のアイデアです。
ーーー
既出回答のエラートラップも良いと思います。

お礼

回答ありがとうございます。
ちょっと質問が言葉足らずだったようです。
「結合されたセルの一部を変更することはできません」のエラーを回避することではなく、このエラーが出るべきタイミングで特定のマクロのを自動実行させる方法をお聞きしたいのです。
具体的には、エクセルシートで結合されているセルをマウスで選択し、ドラッグし、ドラッグ先が自分自身（又は他の結合セルでもいいんですが）に被っていて、通常は「結合されたセルの一部を変更することはできません」とメッセージが出るところで、自動的に任意のマクロを実行する、と言うことです。

回答No.2

Ce_faci

こんばんわ
エラー番号で処理しようにも、１００７が出る前に
マクロの実行エラー１００４が出ますね。それでもいいんですけどね。
そこで、エラーメッセージで条件分けしてみました。カッコ悪いですけれど。
私のＰＣでは動きます。
以下コードです。
例では、セルＡ６：Ｃ６を結合して、試しました。

Sub 私の過ち()
On Error Resume Next
'ココにお好みのコピーのコードを書いてください
ActiveSheetRange("A1:B1").Copy Destination:=Range("A6")

If Err.Description = _
"結合されたセルの一部を変更することはできません。" Then

'Call 次にやりたいサブルーチン
MsgBox "迎春"
End If
End Sub

お礼

回答ありがとうございます。
恐れ入りますが、No3のお礼を参照願います。

回答No.1

toshi_2000

このエラー番号は、１００４です。
エラートラップ処理をしたらどうでしょう。

補足

回答ありがとうございます。
恐れ入りますが、No3のお礼を参照願います。