二つのセルにある文字を入れ替える
昨日は、選択範囲が飛び飛びでも、ランダムに文字を移動できるようにしてみた。
infoment.hatenablog.com
これを応用して、今日は「二つのセルにある文字の入れ替え」に挑戦する。
二つのセルの文字を手作業で入れ替えるのは、意外と面倒くさい。
そこで、選択したセルの文字同士を入れ替える仕掛けを設けてみる。
一瞬で終わると、入れ替わったかどうか良く判らないので、昨日までの仕掛けで直感的に確認できるようにした。
クラスモジュール(TextboxClass)
Public Sub ExchangeString() If TargetRange.Count <> 2 Then MsgBox "値を入れ替えたいセルを二つ選択して、" & vbNewLine & _ "再度実行してください。" Exit Sub End If ReDim DestinationRange(1 To iMax) Dim r As Range Dim i As Long: i = 2 For Each r In TargetRange Set DestinationRange(i) = r i = i - 1 Next Call CellToTextbox Call MovingTextBox Call TextboxToCell End Sub
この部分については、昨日の記事を参考にされたし。
Call CellToTextbox
Call MovingTextBox
Call TextboxToCell
標準モジュール
例によって、こちら側はいたってシンプルに。
Sub MoveTest3() Dim TBC As TextboxClass Set TBC = New TextboxClass Set TBC.TargetRange = Selection TBC.ExchangeString End Sub
これを、シート上のボタンに設定してみた。
結果はこちら。
見た目も楽しい、文字の入替えが完成した。これが、やりたかったことの三つ目。
実際に使われるかどうかは分からないが、今回も面白かったので、良しとしよう。
参考まで。