サイズの異なる結合セル間でのコピー＆ペースト

質問

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

Excel 2007
Windows XP Proffessional

サイズの異なる結合セル間において、
一括して多数のコピー＆ペーストをしたい場合、
何か良い方法はありますでしょうか。
(ただし、それぞれの結合セルのサイズ等は一切変更できません)

どうぞアドバイスのほどよろしくお願いします。

回答No.10

xls88 · ベストアンサー

下記で合っているでしょうか？
違っていたらその旨教えてください。
「コピー元左上セル」と「貼付け開始左上セル」のシート名、セル番地は実際に合わせてください。

Sub test横横複数行()
　　Dim acell As Range
　　Dim bcell As Range
　　Dim i As Long
　　Dim cn As Long

　　Set acell = Sheets("Sheet1").Range("A1")　'コピー元左上セル
　　Set bcell = Sheets("Sheet1").Range("A5")　'貼付け開始左上セル
　　Do While acell.Offset(0, i).MergeCells
　　　　cn = cn + acell.Offset(0, i).Columns.Count
　　　　i = i + 1
　　Loop

　　Do While bcell.MergeCells
　　　　bcell.Resize(1, cn + 1).Value = acell.Resize(1, cn + 1).Value
　　　　Set bcell = bcell.Offset(1, 0)
　　Loop

　　Set acell = Nothing
　　Set bcell = Nothing
End Sub

お礼

朝早くにご回答ありがとうございます。
試させていただきました。
結果、うまく実行できることを確認しました。
(途中に結合されていないセルがあるとその手前で止まる仕様なのですね。)

非常に助かりました。
ありがとうございます。

回答No.9

xls88

>コピー元 Ａ Ｂ Ｃ Ｄ
>コピー先 Ａ Ｂ Ｃ Ｄ
>コピー先 Ａ Ｂ Ｃ Ｄ
>コピー先 Ａ Ｂ Ｃ Ｄ
>コピー先 Ａ Ｂ Ｃ Ｄ
上記のようになって欲しいのですか？

コピー元は1行
コピー先では、
同じ方向で
4行貼りつける
コピー先の行数は、コピー元のデータ数と同じ
ということですか？

今一度、コピー元とコピー先のレイアウト、結合セルサイズを説明していただけないでしょうか。

お礼

やりたいことをうまく説明できておらず、申し訳ありません。

＞上記のようになって欲しいのですか？
はい。

＞コピー先では、
＞同じ方向で
＞4行貼りつける
例では４行としていますが、１００行以上あります。

＞コピー先の行数は、コピー元のデータ数と同じ
＞ということですか？
すみません。
こちらの意味はわかりませんでした。

次のようにしたいのです。

０ コピー元の値： Ａ Ｂ Ｃ Ｄ
１ コピー先の値： Ａ Ｂ Ｃ Ｄ
２ コピー先の値： Ａ Ｂ Ｃ Ｄ
３ コピー先の値： Ａ Ｂ Ｃ Ｄ
・ ・
・ ・
・ ・
・ ・
・ ・
１００ コピー先の値： Ａ Ｂ Ｃ Ｄ

※Ａ、Ｂ、Ｃ、Ｄが格納されているコピー元のセルは、
Ａ＝３行２列、Ｂ＝３行３列、Ｃ＝３行３列、Ｄ＝３行３列の結合セル。
※Ａ、Ｂ、Ｃ、Ｄが格納されるコピー先のセルは、
いろいろなパターンの結合セルです。
(項番０、１、２、３それぞれで異なる行数の結合セルという意味)

回答No.8

xls88

ANo.4の返事
>結合セルが横に複数ある場合、それを縦方向にコピーするには
ANo.7の返事
>コピー元 Ａ Ｂ Ｃ Ｄ
>コピー先 Ａ Ｂ Ｃ Ｄ
内容が異なっているのですが、新しい返事の方が正解なら余り考えなくても良くなります。
下記の部分で縦か横かを制御しています。
直し方は、ヘルプでOffsetプロパティを調べれば直ぐに分かると思います。

Set acell = acell.Offset(1, 0)
Set bcell = bcell.Offset(1, 0)

お礼

アドバイスありがとうございます。
内容が異なっている認識はないのですが・・・
もし表現(Excelの言葉の定義を誤っている？)が異なっているので
したらすみません。

＞新しい返事の方が正解なら
なおりました。
ただ、次のようにしかコピーできないようです。
コピー元 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ
コピー先 Ａ
コピー先 Ａ
コピー先 Ａ

教えてくださったコードを元に、
コピー元 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ｂ
コピー先 Ａ Ｂ
コピー先 Ａ Ｂ
コピー先 Ａ Ｂ

コピー元 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ｂ Ｃ
コピー先 Ａ Ｂ Ｃ
コピー先 Ａ Ｂ Ｃ
コピー先 Ａ Ｂ Ｃ

コピー元 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ｂ Ｃ Ｄ

となるようにコードを検討すれば良いのかな？と
思って試行錯誤していますが、うまくいかないようです。

回答No.7

xls88

取りあえずANo.5のコードを誤魔化してみました。
完璧とは言えません。
更に考えてみます。

Sub test縦横()
　　Dim acell As Range
　　Dim bcell As Range

　　Set acell = Sheets("Sheet1").Range("D1")
　　Set bcell = Sheets("Sheet2").Range("B1")

　　Do While acell.Value <> "" Or bcell.Value <> ""
　　　　If acell.Value <> "" And bcell.Value = "" Then
　　　　　　bcell.Value = acell.Value
　　　　ElseIf acell.Value = "" And bcell.Value <> "" Then
　　　　　　acell.Value = bcell.Value
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　　　If acell.Offset(1, 0).MergeCells Then
　　　　　　Set acell = acell.Offset(1, 0)
　　　　　　Set bcell = bcell.Offset(0, 1)
　　　　Else
　　　　　　Set acell = acell.Offset(0, 1)
　　　　　　Set bcell = bcell.Offset(1, 0)
　　　　End If
　　Loop

　　Set acell = Nothing
　　Set bcell = Nothing
End Sub

# 余談を聞き入れていただきありがとうございました。
# 気分を害していることはありませんので気にしないでください。
# よろしくお願いいたします。

お礼

引き続きのご対応ありがとうございます。
ご親切にありがとうございます。
試させていただきました。
下記のように４つの結合セルが並んでいるのですが、
教えてくださったマクロを実行したところ、
次のようになりました。

コピー元 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ａ

実現したいのは、次のような動きなのですが、
使い方が悪いのでしょうか？

コピー元 Ａ Ｂ Ｃ Ｄ
コピー先 Ａ Ｂ Ｃ Ｄ

回答No.6

xls88

>結合セルが横に複数ある場合、それを縦方向にコピーするには
ハードルが上げられましたね。
考えてみます。

補足

ご指摘ありがとうございます。

＞何らかの返事を差し上げるべきではないでしょうか

実施することが不明瞭なため、試せずにおり、返答に困っていました。
もし気分を害したのであれば申し訳ありません。

回答No.5

xls88

ANo.4のコードを見直してみました。

Sub test2()
　　Dim acell As Range
　　Dim bcell As Range

　　Set acell = Sheets("Sheet1").Range("A1")
　　Set bcell = Sheets("Sheet2").Range("B1")

　　Do While acell.Value <> "" Or bcell.Value <> ""
　　　　If acell.Value <> "" And bcell.Value = "" Then
　　　　　　bcell.Value = acell.Value
　　　　ElseIf acell.Value = "" And bcell.Value <> "" Then
　　　　　　acell.Value = bcell.Value
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　　　Set acell = acell.Offset(1, 0)
　　　　Set bcell = bcell.Offset(1, 0)
　　Loop

　　Set acell = Nothing
　　Set bcell = Nothing
End Sub

回答No.4

xls88

試しにマクロを組んでみました。
結合セル・非結合セルを問いません。

Sub test()
　　Dim acell As Range
　　Dim bcell As Range
　　Dim myccell As Range
　　Dim mypcell As Range

　　Set acell = Sheets("Sheet1").Range("A1")
　　Set bcell = Sheets("Sheet2").Range("B1")

　　If acell.Value <> "" And bcell.Value = "" Then
　　　　Set myccell = acell
　　　　Set mypcell = bcell
　　ElseIf acell.Value = "" And bcell.Value <> "" Then
　　　　Set myccell = bcell
　　　　Set mypcell = acell
　　Else
　　　　Exit Sub
　　End If

　　Do While myccell.Value <> ""
　　　　mypcell.Value = myccell.Value
　　　　Set mypcell = mypcell.Offset(1, 0)
　　　　Set myccell = myccell.Offset(1, 0)
　　Loop

　　Set acell = Nothing
　　Set bcell = Nothing
　　Set mypcell = Nothing
　　Set myccell = Nothing
End Sub

お礼

アドバイス、コードのご教示ありがとうございます。
試してみました。
１つの結合セルをみごとに縦方向にコピーできました。
ありがとうございます。
結合セルが横に複数ある場合、それを縦方向にコピーするには
どのようにすればよろしいでしょうか？

回答No.3

xls88

結合セルが連続している
コピー元、コピー先の結合セルサイズは異なる
コピー元の結合セルサイズは一定で同じ(例：2行1列)
コピー先の結合セルサイズも一定で同じ(例：3行2列)
といった前提条件が許される場合

仮に
コピー元：Sheet1のA列、結合サイズは2行1列
コピー先：Sheet2のA列、結合サイズは3行2列
とします。

コピー先結合セルの先頭に、#Sheet1!A1
コピー先結合セルの2番目に、#Sheet1!A2
と入力
入力した 2個の結合セルを選択
選択枠の右下角の■(フィルハンドル)を下方にドラッグ&ドロップ
そのまま範囲選択状態で
「置換」で
検索する文字列を、#
置換後の文字列を、=
として「すべて置換」
続けて、そのままの範囲選択状態で
Ctrl＋Cで、コピー
「形式を選択して貼り付け」の「値」で貼り付け

といった操作を試してください。

補足

アドバイスありがとうございます。
実施する内容がいまいちよくわかりませんでした。

回答No.2

fujillin

サイズや結合を変えられないということは、値だけをコピーするという意味だと解釈できますが、個別セルの値を転記する形のループにすれば、エラーにはならず、コピーすることが可能です。（コードは1行では済みませんが・・・）

ただし、セルの結合の形が違うので、どの値が生きてどの値が無視されてしまうかは、それぞれの結合の対応関係によります。
（結合セルの値は左上のセルが代表となっているため）

　サンプルを示すまでもないでしょうが、一応・・・
For col = 1 To 10
　For rw = 1 To 5
　　Cells(rw + 5, col + 10).Value = Cells(rw, col).Value
　Next rw
Next col

お礼

アドバイスありがとうございます。
試してみようとしたのですが、試し方が判りませんでした。

回答No.1

higekuman

そのままは無理だと思います。

コピー元のデータを一旦別のところにペーストして、結合を解除し、コピー先の結合と同じサイズに結合しなおしてから、それをコピー先にコピー＆ペーストする、という方法はどうでしょうか？

お礼

アドバイスありがとうございます。
どのような内容をご指摘されているのか？を少し考えました。
せっかくなのですが、
アドバイスくださった内容ですと、数が膨大なため、あまり
手入力からのメリットがないように思います。