|
こんばんは。
シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Count > 1 Then Exit Sub
If IsEmpty(.Value) Then Exit Sub
If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
If .Value = "○" Then
Application.EnableEvents = False
.Offset(0, 4).Value = .Offset(0, 4).Value + 1
Application.EnableEvents = True
End If
End If
End With
End Sub
とすれば、もしE列に○をつけるとI列にカウントアップされます。
以下のSub test2()と組み合わせると自動的にカウントアップされ、
カウントの一番少ない人の中で一番上の行の人に○がつきます。
標準モジュールに
Sub test2()
Dim myMin As Integer
Dim myRow As Long
Range("E:E").ClearContents
'F26からF33の中でカウントの最も少ない一番上の行の人に"○"をつける。
myMin = Application.Min(Cells(26, "I").Resize(8, 1))
myRow = Application.Match(myMin, Cells(26, "I").Resize(8, 1), 0)
Range("E" & myRow + 26 - 1).Value = "○"
'F34から5人ずつの中でカウントの最も少ない一番上の行の人に"○"をつける。
For i = 34 To 531 Step 5
myMin = Application.Min(Cells(i, "I").Resize(5, 1))
myRow = Application.Match(myMin, Cells(i, "I").Resize(5, 1), 0)
Range("E" & myRow + i - 1).Value = "○"
Next
End Sub
ただし、Match関数は空欄では、エラーを起こすので、一番はじめに一回だけ
I列に"0"を入れていてください。
それから、
>まず、無条件に4箇所(E3,E11,E16,E21)に○をつけます
の人は、F26以降には出てこないのですか?
もし出てくるのなら上記コードはすべてボツです。
F列を検索して、E3,E11,E16,E21と同じ名前の人のカウンタを+1するコードをを追加しなければなりません。これは、前に回答した中にあったと思います。
E3,E11,E16,E21の値を配列に入れ、F列をFor Eachで検索して、一致したら、Offset(0,3)の値を+1すればよいと思います。
4箇所(E3,E11,E16,E21)の人とF26以降の人との関係が分かりません。
もう一度、シートの詳しいレイアウトを提示して、上級者の方に別途再質問された方が
よいかもしれません。
私のようなものが最初に答えたばっかりに申し訳ありません。
|
|