二つのセルにある文字を入れ替える

昨日は、選択範囲が飛び飛びでも、ランダムに文字を移動できるようにしてみた。
infoment.hatenablog.com
これを応用して、今日は「二つのセルにある文字の入れ替え」に挑戦する。

二つのセルの文字を手作業で入れ替えるのは、意外と面倒くさい。
f:id:Infoment:20181212232120p:plain
f:id:Infoment:20181212232145p:plain
f:id:Infoment:20181212232205p:plain

そこで、選択したセルの文字同士を入れ替える仕掛けを設けてみる。
一瞬で終わると、入れ替わったかどうか良く判らないので、昨日までの仕掛けで直感的に確認できるようにした。

クラスモジュール(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

これを、シート上のボタンに設定してみた。
結果はこちら。
f:id:Infoment:20181212232915g:plain

見た目も楽しい、文字の入替えが完成した。これが、やりたかったことの三つ目。

実際に使われるかどうかは分からないが、今回も面白かったので、良しとしよう。

参考まで。