プロが教えるわが家の防犯対策術!

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

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

質問2
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以下)

A 回答 (3件)

こんばんは。



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

'シートモジュール(シートタブを右クリック--コードの表示)
'-------------------------------------------
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
    • good
    • 0

前回のURLを貼った方が質問内容の理解促進に役立ちます。


≪前回質問≫
今日からトライしているexcel vbaの初心者です。
http://oshiete1.goo.ne.jp/qa5577697.html

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

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

こんにちは。


標準モジュールを追加し次のようにしてください。
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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!