先般、下記のvbaのコーディング事例の回答を頂きました。

質問

先般、下記のvbaのコーディング事例の回答を頂きました。
再度ご質問させて頂きたく、よろしくお願いします。

質問１
a列に点数を入力すると同時にb列に表示させたい。
→This workbookのPrivate Sub Workbook_Open()にvbaを登録するのでしょうか？

質問２
a列に点数が入力された場合のみb列を表示させたい。

===================
a1～a100のセルに点数が入力されているとします。
その点数を元に下記の通りb列にランクを自動的に付ける場合の
vbaのコーディングはどうなりますか？

ss(95以上)
a(90-94)
b(85-89)
c(80-84)
d(75-79)
e(70-74)
f(65-69)
g(60-64)
h(55-59)
i(50-54)
j(50以下)

回答No.3

Wendy02 · ベストアンサー

こんばんは。

こんな感じでどうでしょうか？

'シートモジュール(シートタブを右クリック--コードの表示）
'-------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim Ret As Variant
　　If Target.Column <> 1 Then Exit Sub
　　If Target.Count > 1 Then Exit Sub
　　If IsNumeric(Target.Value) = False Then Exit Sub
　　Ret = RankLookUp(Target.Value)
　　If Ret = 0 Then Exit Sub
　　Application.EnableEvents = False
　　Target.Offset(, 1).Value = Ret
　　Application.EnableEvents = True
End Sub

Function RankLookUp(arg As Variant) As String
　　Dim Data(10)
　　Dim Chars(10)
　　Dim i As Long, j As Long, k As Variant
　　'除外項目
　　If IsNumeric(arg) = False Then Exit Function
　　If arg < 0 Then RankLookUp = 0: Exit Function
　　If arg > 100 Then RankLookUp = 0: Exit Function

　　Data(10) = 95:　　Chars(10) = "ss"
　　Data(0) = 0:　　 Chars(0) = "j"
　　For i = 50 To 90 Step 5
　　　　j = j + 1
　　　　Data(j) = i
　　　　Chars(j) = Chr(106 - j)
　　Next i
　　On Error Resume Next
　　k = Empty
　　k = Application.Match(arg, Data, 1)
　　On Error GoTo 0
　　If Not IsEmpty(k) Then
　　　　RankLookUp = Chars(k - 1)
　　End If

End Function

回答No.2

xls88

前回のURLを貼った方が質問内容の理解促進に役立ちます。
≪前回質問≫
今日からトライしているexcel vbaの初心者です。
http://oshiete1.goo.ne.jp/qa5577697.html

質問１と質問２を実現するには、シートのイベントプロシージャを利用します。
≪参考≫
ワークシートのイベント
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_event.html

色々ありますが、Worksheet_Changeイベントが使えると思います。

回答No.1

avanzato

こんにちは。
標準モジュールを追加し次のようにしてください。
Option Explicit

Sub Sample()
　　Dim I As Integer
　　Dim Ret As String
　　For I = 1 To 100
　　　　Select Case Range("A" & I).Value
　　　　　　Case Is >= 95
　　　　　　　　Ret = "SS"
　　　　　　Case Is >= 90
　　　　　　　　Ret = "A"
　　　　　　Case Is >= 85
　　　　　　　　Ret = "B"
　　　　　　Case Is >= 80
　　　　　　　　Ret = "C"
　　　　　　Case Is >= 75
　　　　　　　　Ret = "D"
　　　　　　Case Is >= 70
　　　　　　　　Ret = "E"
　　　　　　Case Is >= 65
　　　　　　　　Ret = "F"
　　　　　　Case Is >= 60
　　　　　　　　Ret = "G"
　　　　　　Case Is >= 55
　　　　　　　　Ret = "H"
　　　　　　Case Is >= 50
　　　　　　　　Ret = "I"
　　　　　　Case Else
　　　　　　　　Ret = "J"
　　　　End Select
　　　　Range("B" & I).Value = Ret
　　Next I
End Sub