必ず、セル選択順に 数字を表示させるには ？

質問

必ず、任意のセルの選択順に数字を表示させたいんです。

D列には、　1 ～ 10　が入力されております。
E列は、空白です。
F列のセルを、　任意選択する回数は、2回　か　3回　だけです。

下記例　（ 任意のセルを、　3回選択する場合です ）　の、マクロを何卒、ご教授ねがいます。
------------------------------------------
実行前 （ F列　の　任意のセル　を選択します ）
D列　　Ｅ列　　Ｆ列
1　　　　　　　 とと ←3回目の選択
2　　　 　　　　ああ
3　　　 　　　　うう
4　　　 　　　　いい ←1回目の選択
5　　　 　　　　おお
6　　　 　　　　ええ
7　　　 　　　　はは
8　　　 　　　　ふふ
9　　　 　　　　ひひ
10　　 　　　　ほほ ←2回目の選択

↓↓↓↓
実行後 （ Ｅ列に　選択順の数字　が表示される　）
D列　　Ｅ列　　Ｆ列
1　　　 3　　　 とと ←3回目の選択
2　　　 　　　　ああ
3　　　 　　　　うう
4　　　 1 　　　いい ←1回目の選択
5　　　 　　　　おお
6　　　 　　　　ええ
7　　　 　　　　はは
8　　　 　　　　ふふ
9　　　 　　　　ひひ
10　　 2 　　　ほほ ←2回目の選択

回答No.3

nekotaru · ベストアンサー

Ｆ列以外を選択したら、０に戻せばいいのか。。
imogasiさま、参考になりました。

Option Explicit

Dim i As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 6 Then
'F列が選択された
i = i + 1
Cells(Target.Row, 5) = i
else
Columns("E").Clear
i=0
End If

End Sub

お礼

即答、誠に有難うございます。
バッチリでした。

回答No.4

Wendy02

こんにちは。

シートモジュールに貼り付けてください。
E列のデータが邪魔になったら、ご自分で消去してください。

'---------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 6 Then Exit Sub
If IsEmpty(Target.Value) Then Exit Sub
With Range("F1", Range("F1").End(xlDown))
　 Target.Offset(, -1).Value = WorksheetFunction.Max(.Offset(, -1)) + 1
End With
End Sub

'---------------------------------------------

お礼

ご回答、誠に有難うございました。
皆様が、良回答でした。

回答No.2

imogasi

＃１とほぼおなじですが（ちょっと違う）
標準モジュールに
Public i
Sub test01()
i = 0
Columns("E").Clear
End Sub
ーー
Sheet1のシートモジュールのSelectionChangeイベントに
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 6 Then
i = i + 1
Cells(Target.Row, "E") = i
End If
End Sub
ーーー
実行に先立ちTest01を実行（初期化）
Sheet1のF列でクリックすると順番数字がE列に出る。
E列　　F列
（例）
a
b
2 c
d
1 e
f
3 g
h
4 i
e,c,g,iの順にクリックした結果。
本当は重複クリックや下限をチェック必要でしょうが略。

お礼

即答、誠に有難うございました。
皆様が、良回答でした。

回答No.1

nekotaru

処理を行いたいシートに下記を貼り付けてください。
自分の環境で簡単にテストしたかぎりでは動きました。
ただ、１に戻す起因がないので、そこは改善の余地があると思います。
ＶＢＡの記述方法がわからない場合は別途補足ください。

Option Explicit

Dim i As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 6 Then
'F列が選択された
i = i + 1
Cells(Target.Row, 5) = i
End If

End Sub