|
▼にしもり さん、ponpon さん:
こんにちは。
>これ以上お聞きすると「おんぶにだっこ」になってしまいますので
>以後は自力でやってみます。
とのスレッドに書き込むのをお許し下さい。
参考程度にでも使ってやって下さい。
F列に既に名前が入っている事と、2行目に表題がついている事が前提です。
Sub 平準化()
Dim I As Long
Dim J As Long
Dim K As Long
Dim MyRange As Range
ActiveSheet.Range("Z2").Value = "回数"
ActiveSheet.Range("Z3:Z531").Value = 0
For I = 3 To 531
Select Case I Mod 23
Case 3
J = I + 7
Case 11, 16, 21
J = I + 4
End Select
Set MyRange = ActiveSheet.Range("Z" & I & ":Z" & J)
For K = 1 To MyRange.Count
If MyRange(K) = WorksheetFunction.Min(MyRange.Value) Then
MyRange(K).Offset(0, -21).Value = "○"
Call カウントアップ(MyRange(K))
Exit For
End If
Next
I = J
Next
Set MyRange = Nothing
End Sub
Sub カウントアップ(MyRange As Range)
Dim R As Range
ActiveSheet.Range("F2:F531").AutoFilter _
Field:=1, Criteria1:=MyRange.Offset(0, -20).Value
Set R = Range("Z2", "Z" & Range("Z65535").End(xlUp).Row)
R.Value = R(2).Value + 1
Set R = Nothing
ActiveSheet.AutoFilterMode = False
End Sub
Z列を作業列としてカウント数を表示してありますが、
動作が確認できましたら消して下さい。
お邪魔しました。
|
|