ＥＸＣＥＬ２００３ 選択した範囲のデータの入れ替え

質問

はじめまして。Ｅxcel２００３を使っています。
離れたセルを複数選択して（Ａ１～Ｄ１）と（Ｃ６～Ｄ６）双方のデータを入れ替えることはできるでしょうか？
ちなみに（Ａ１には数字・文字のデータ　Ｂ１～Ｄ１はセルの色づけだけ）同様に（Ｃ６に数字・文字データ
Ｂ６～Ｄ６はセルの塗りつぶしだけ）の入れ替えです。
現在は、コピーして離れたセルに貼り付けてを繰り返して双方を入れ替えしてます。
ＶＢＡでコード表を作る能力がありませんので、作っていただければ助かります。

Ａ範囲選択　Ｃｔｒｌ　Ｂ範囲選択　　Ｅｎｔｅｒ　でデータの入れ替えができれば使いやすいのですが・・・

はじめての質問で説明が解りにくいかもしれませんがよろしくお願いします。

回答No.2

mt2008 · ベストアンサー

> データの入れ替えはできましたが、書式（色の付いたセル）も同時に入れ替え可能にすることはできるのでしょうか？

で、あれば別なシート等に一時コピーをして張り付ける形になると思います。

Sub sample2()
　　Dim wsSwap As Worksheet '一時コピー用シート

　　Application.ScreenUpdating = False 'シートを追加したりするので画面更新停止
　　Set wsSwap = Worksheets.Add '一時コピー用シート作成
　　ActiveSheet.Next.Activate 'アクティブシートを戻す

　　With Selection

　　　　If .Areas.Count <> 2 Then
　　　　　　MsgBox ("セル範囲を2つ選択してください")
　　　　　　Exit Sub
　　　　End If
　　　　If (UBound(.Areas(1).Value, 1) <> UBound(.Areas(2).Value, 1)) Or (UBound(.Areas(1).Value, 2) <> UBound(.Areas(2).Value, 2)) Then
　　　　　　MsgBox ("2つのセル範囲のサイズが違います")
　　　　　　Exit Sub
　　　　End If
　　　　'セル範囲のコピー
　　　　.Areas(1).Copy wsSwap.Range("A1")
　　　　.Areas(2).Copy .Areas(1)
　　　　wsSwap.Range("A1").CurrentRegion.Copy .Areas(2)

　　End With

　　'一時コピー用シートを削除
　　Application.DisplayAlerts = False
　　wsSwap.Delete
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True '画面更新再開
End Sub

お礼

親切に教えていただいて感謝してます。
お礼も言わずにに質問ばかりですみませんでした。

質問の様な動作がエクセルの機能にありそうでないんですね
プログラムで、自分のしたい作業が簡単になることで、こんなに感動できるとは思いませんでした。
自分でも小さなプログラムが作れるようになりたいです。

ｍｔ2008さん　ありがとうございます。

補足

ありがとうございます。早速試してみました。

一つ目の選択範囲（A1データ　B1色だけ　C1色だけ　D1データ　E1　色だけ）
二つ目の選択範囲（A6データ　B6色だけ　C6色だけ　D6色だけ　E6　色だけ）

実行すると　

一つ目の選択範囲に（A6データ　B6色だけ　C6色だけ　D6色だけ　E6　色だけ）
二つ目の選択範囲に（A1データ　A1データ　A1データ　A1データ　A1データ　）

となります。

もとに戻そうとさらに実行すると

一つ目の選択範囲に（A1データ　A1データ　A1データ　A1データ　A1データ　）
二つ目の選択範囲に（A6データ　A6データ　A6データ　A6データ　A6データ　）

となります。

二つ目の選択範囲はそのまま張り付きますが、一つ目の選択範囲の方が、先頭のセルの書式とデータが一つ目以降の選択範囲のセル全部に張り付けになるのですが、改善できるでしょうか？

それができると助かります。

お願いします

回答No.1

mt2008

簡単なサンプルです。
セル範囲を2つ選択した後でこのマクロを動かすとデータの入れ替えを行います。
「データ」の入れ替えるだけですので書式は入替えていません。

Sub sample()
　　Dim vWork() As Variant

　　With Selection.Areas
　　　　If .Count <> 2 Then
　　　　　　MsgBox ("セル範囲を2つ選択してください")
　　　　　　Exit Sub
　　　　End If
　　　　MsgBox (UBound(.Item(1).Value, 1))
　　　　If (UBound(.Item(1).Value, 1) <> UBound(.Item(2).Value, 1)) Or (UBound(.Item(1).Value, 2) <> UBound(.Item(2).Value, 2)) Then
　　　　　　MsgBox ("2つのセル範囲のサイズが違います")
　　　　　　Exit Sub
　　　　End If
　　　　vWork() = .Item(1).Value
　　　　.Item(1) = .Item(2).Value
　　　　.Item(2) = vWork()
　　End With
End Sub

お礼

ありがとうございます。
マクロが動作して感動しました。

カユイ所に手が届きそうです。

補足

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

データの入れ替えはできましたが、書式（色の付いたセル）も同時に入れ替え可能にすることはできるのでしょうか？

イメージは　セルのコピー　貼り付けのように書式とデータを一気に入れ替えたいです。