Excel VBA セルの値だけを入れ替えるマクロ
さて,いつになったらパワーポイントのマクロに戻れるのか。
実務のほうがそのモードに入るまでもうちょいかかりそう。
どうも春から生活が変化しそうです。楽しみです。
さて,高等学校では4月になると時間割が作られます。
時間割作成ソフトというのがあるので,その機能である程度までは形にするんですが,どうしても最後のほうの書式は自分でカスタマイズしていきたいもの。
また,その時間割のデータをいろんな形に加工して利用するので,そこはExcelVBAの出番。
いろいろな書式が施されているうえで,値だけ入れ替えたいんだよね,というケースに頻繁に出会う仕事です。
その準備をしておこうと思いましたので,書式を変えずデータだけ入れ替える,というマクロを用意しました。
ある程度の大きさの連続範囲を入れ替えるということもよくやるので,そのイメージでコードを書いた。
あと,ApplicationオブジェクトのmacroOptionsでショートカットキーを設定する,というのも知りませんでしたので,そちらも使用。
うん,これは短いけど使えそうだ。
VBAコード(改善前)
Option Explicit Sub SetShortcut() Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="r" End Sub Sub RemoveShortcut() Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="" End Sub Sub ReplaceValues() Dim SelectionRange As Range: Set SelectionRange = Selection If SelectionRange.Areas.Count <> 2 Then Exit Sub Dim ColumnsCount As Long, RowsCount As Long ColumnsCount = SelectionRange.Areas(1).Columns.Count RowsCount = SelectionRange.Areas(1).Rows.Count Union(SelectionRange.Areas(1), SelectionRange.Areas(2).Resize(RowsCount, ColumnsCount)).Select Set SelectionRange = Selection Dim tmp(): ReDim tmp(1 To 2, 1 To RowsCount, 1 To ColumnsCount) Dim i As Long, j As Long, k As Long For k = 1 To 2 For i = 1 To RowsCount For j = 1 To ColumnsCount tmp(k, i, j) = SelectionRange.Areas(k).Value2(i, j) Next Next Next With SelectionRange.Areas(1) For i = 1 To RowsCount For j = 1 To ColumnsCount .Cells(i, j) = tmp(2, i, j) Next Next End With With SelectionRange.Areas(2) For i = 1 To RowsCount For j = 1 To ColumnsCount .Cells(i, j) = tmp(1, i, j) Next Next End With End Sub
VBAコード(改善後)
追記になります。imihitoさんからのご指摘を適用してみました。
Option Explicit Sub SetShortcut() Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="r" End Sub Sub RemoveShortcut() Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="" End Sub Sub ReplaceValues() Dim SelectionRange As Range: Set SelectionRange = Selection If SelectionRange.Areas.Count <> 2 Then Exit Sub Dim ColumnsCount As Long, RowsCount As Long ColumnsCount = SelectionRange.Areas(1).Columns.Count RowsCount = SelectionRange.Areas(1).Rows.Count Union(SelectionRange.Areas(1), SelectionRange.Areas(2).Resize(RowsCount, ColumnsCount)).Select Set SelectionRange = Selection Dim tmp With SelectionRange tmp = .Areas(1).Value2 .Areas(1).Value2 = .Areas(2).Value2 .Areas(2).Value2 = tmp End With End Sub
めちゃくちゃ短くなり,しかもシンプルになりました。イイですね。すばらしい。。
使い方
使用法はいたってシンプル
まずSetShortCutマクロを一度実行をしておいてください。
この設定はブックに保存されるらしいので,一度設定すればこのブックを開くとショートカットはもう設定されたままになっています。
replaceなので ctrl+r に設定していますが,隣をコピーする,というショートカットを愛用している方はほかのショートカットにしてください。
解除方法としてRemoveShotrCutマクロを準備しています。
面白い仕組みですね。初めて知った内容でした。
ctr+rを押すと選択している範囲1と範囲2の値が入れ替わります。
危険でもありますが,利便性のために,範囲2の形は範囲1の形に強制的に合わせられます。
なので,範囲2は範囲2の左上のセルを指定するだけで十分です。
値を入れ替えているだけなので,もう一度ctrl+rを押すともとに戻せます(ΦωΦ)
一応数式を同じようにすることも簡単そうでした。Value2ではなくFormulaR1C1とかを取得して書かせるようにしたらたぶんできる。
でも,それは良し悪しで,値を入れ替えるというのがわたしの目的には適していたので今回は値の入れ替えをします。
コードの説明
Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:="r" Application.MacroOptions Macro:="ReplaceValues", HasShortcutKey:=True, ShortcutKey:=""
ショートカットの設定と,解除のところです。ctrl+shift+r を設定したい場合は ShortCutKey:="R"にすればよいそうです。
Union(SelectionRange.Areas(1), SelectionRange.Areas(2).Resize(RowsCount, ColumnsCount)).Select Set SelectionRange = Selection
複数のセル範囲を得るためにUnionを使っています。
また,SelectionReangeを変化させたかったので,Setしなおしています。
For k = 1 To 2 For i = 1 To RowsCount For j = 1 To ColumnsCount tmp(k, i, j) = SelectionRange.Areas(k).Value2(i, j) Next Next Next
ここは無念でした。For Eachで書きたかった>< でも思いつかなかった。
そのこだわりは無意味だったので,素直に書きました。
離れた数か所のセルを選んでいるときは,それぞれはAreas(インデックス)に収められます。
そして,これも私はあまり使ったことなかったValue2プロパティ
値を二次元で格納してくれていましたので,今回利用させてもらいました。便利だなぁ。
ちなみに
FormulaR1C1も同じように格納されています。
今回は3次元の配列が便利だったので,tmpは3次元の配列です。
動作動画