質問: Replace(UperCell, "@", "@@") End If End If End Sub ```
回答: 各所にブレークポイントを設定するなどして、各変数やプロパティの値が何になっているかを調べてみるとよいと思います。 * ActiveCell = 移動後のセル * LeftCell = ActiveCell.Previous = 移動後のセルの左 * UperCell = ActiveCell.Offset(-1,0) = 移動後のセルの上 それを踏まえると・・・ ``` If ActiveCell.row >= 2 And _ ActiveCell.Column = 5 Then ``` これは移動後のセルがE列2行目であることを確かめていますから、D列で下に移動した場合には該当しません。D列で右に移動した時や、E列で下に移動したときに該当します。 ``` '文字のカウントの結果が1個だけであり、LeftCellがアクティブでなくなったら If kazA = 1 And LeftCell <> ActiveCell.Previous.Address Then ``` LeftCellの座標とActiveCell.Previousの座標を比較したいようですが、Rangeオブジェクトである `LeftCell` の値を取得しようとすると、 `LeftCell.Value` と書いた時のようにセルの内容が取得されます。「左隣のセルの内容」と「左隣のセルの座標」を比較してしまっているわけです。 もっとも、座標の比較であればLeftCellとActiveCell.Previousは常に等しくなるわけですが・・・。 それはそれとして `SelectionChange` よりも、セルの内容が変更されたときに発生する `Change` イベントの方がよいでしょう。このイベントでは変更されたセルを取得することができるので、左と上のどちらのセルが変更されたのか調べる必要がなくなります。 ``` Private Sub Worksheet_Change(ByVal Target As Range) Dim targetStr As String, count As Integer 'D列の2行目以下でなければ終了 If Target.Row < 2 Or Target.Column <> 4 Then Exit Sub targetStr = Target.Text 'Target内の、2個にしたい文字をカウントする For i = 1 To Len(targetStr) If Mid(targetStr, i, 1) = "@" Then count = count + 1 Next i 'カウント結果が1回なら If count = 1 Then Target.Value = Replace(targetStr, "@", "@@") End If End Sub ``` 他にも文字の出現回数の調べ方を変えたり、2個見つけた時点で数えるのをやめたり、3個以上存在する可能性を考慮しなくていいのであれば先に `@@` を `@` に置き換えたり、色々いじる余地はありますが、とりあえずはこれだけでも十分でしょう。