複数セルの入れ替え方法 excel vba

以下のケース
　　　　A列　　B列　　C列　・・・・

　　 　あ町 理科　　C1００
　→　い町　　英語　　C200
　　　　さ町　　数学　　C300　　　　　
　→　ウ町　　習字　　C400

　　　→は選択されている行。

　　　　　これを入れ替えて以下の並びにしたいのです。
　　　　　あ町 理科　　C1００
　　　　　ウ町　　英語　　C200
　　　　 さ町　　数学　　C300　
　　　　　い町　　習字　　C400　

　　　　

No.1 回答者： cozycube1 回答日時： 2012/10/21 08:22

　A1からC4までをドラッグして、A列で「並べ替え(S)」（メニューの「データ(D)」にある）すれば、ご希望の並べ替えができます（お示しの並べ方だと昇順）。

それをVBAで記録すれば、元となるコードが得られますので、適宜、改造するといいのではないかと思います。

No.2 回答者： atom_28 回答日時： 2012/10/21 09:08

VBAではないので、参考としてください。

１．「い町」をセレクトする
２．シフトを押しながら、「い町」の黒枠をクリックして「ウ町」の下にドラッグ
　　(Iの字の線が出ることで確認)　　これで、並びは、あさウいになる
３．同様に「さ町」をセレクト、シフトを押しながら、「ウ町」のしたにドラッグ

文章で書くと、ややこしいですが、シフトを押しながらドラッグすると、入れ替えができます。
隣同士であれば、まさに入れ替え。離れていると、そこへ持っていくだけですが。
尚、複数セル、列、行でも、使えます。

その他、膨大なデータに対応することが必要なら、捨て列を1つ臨時に設けて、
そこに１から数字を順番に記入します。
問題の入れ替えたい場所だけ、数字を入れ替えます。で、もって、
2列（「あ町」の列と臨時の列)を選択して、臨時の列についてソートを実行します。
(注：捨て列に１からの番号を入れるやり方。1秒でできます・・・・10000行あっても
　　　A1に１を入れてエンター
　　　A2に２をいれてエンター
　　　A1,A2をセレクト。右下コーナーの黒ボッチをマウスでダブルクリック
　　　　-->結果、A3に３、A4に４が入ります)

No.3 回答者： tom04 回答日時： 2012/10/21 10:50

こんにちは！

「並べ替え」ではなく、単に「ウ町」と「い町」を入れ替えるだけの操作ですね？
淡々と上の行から順番に検索して、入れ替えるだけだと思います。

一例です。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i As Long, str1 As String, str2 As String
str1 = "い町"
str2 = "ウ町"
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 1) = str1 Then
Cells(i, 1) = str2
ElseIf Cells(i, 1) = str2 Then
Cells(i, 1) = str1
End If
Next i
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

No.4 回答者： keithin 回答日時： 2012/10/21 15:20

とりあえず簡易版で、生データとして入れ替えます。

sub macro1()
　dim buf as variant

　if selection.areas.count <> 2 then exit sub
　if selection.areas(1).rows.count <> selection.areas(2).rows.count _
　or selection.areas(1).columns.count <> selection.areas(2).columns.count then
　　msgbox "範囲の形が違います"
　　exit sub
　end if

　buf = selection.areas(1).value
　selection.areas(1).value = selection.areas(2).value
　selection.areas(2).value = buf

end sub



＃「行と行を入れ替える」のように限定的な機能を実現するので良ければ、それに応じて高機能なマクロにすることも簡単になります。寄せられた回答などを参考に、随時研究してみて下さい。

No.5 ベストアンサー 回答者： JazzCorp 回答日時： 2012/10/21 17:12

Sub ExchangeSelectedCell()

Dim xRange As Range
Dim xRow(1 To 10) As Long
Dim xPart As Long
If Selection.Areas.Count > 1 Then
xPart = 1
For Each xRange In Selection.Areas
MsgBox (xPart & " 番目に選択されたのは、" & "行：" & xRange.row)
If (xRow(1) = 0) Then
xRow(1) = xRange.row
Else
xRow(2) = xRange.row
If (xRow(1) > xRow(2)) Then
xRow(2) = xRow(1)
xRow(1) = xRange.row
End If
Exit For
End If
xPart = xPart + 1
Next xRange
Else
Exit Sub
End If
With ActiveSheet
.Rows(xRow(2)).Copy
.Rows(xRow(2)).Insert
.Cells(xRow(2), "A") = .Cells(xRow(1), "A")
.Cells(xRow(1), "A") = .Cells(xRow(2) + 1, "A")
.Rows(xRow(2) + 1).Delete
End With
End Sub

この回答へのお礼

大変遅くなりました。

　恒久ロジックとしてお知恵を拝借します。

コードの理解
最初に選択したセル内容を退避し（行追加）、2番目に選択したセルを内容を
1番目に選択したセルに移し、退避したセル内容を2番目に選択した
セルに戻す。

　Vbaにより記述するとこのようになるのですね。　

　◎実際には、選択した行に複数の項目（列）がありますので
　　退避用エリアを設けご教示して頂いたコードに改造をかけ
　　使えるようになりました。

　　お礼遅くなりました。
　
　　その日に５名の方からご教示頂き感謝しています。

　◎データを入れ替えると関数の再計算が始まり
　　大変時間がかかります。後でわかったことですが
　　自動計算を抑止し入れ替えをするようにしました。
　　
　　マクロでも組み込もうと思っています。

　　　　　　　　　　　　　　　　　　　　　　　以上　　

　　

お礼日時：2012/11/18 16:39