| |
こんばんは。
よく分からないのですが・・・
質問の通りにやってみました。マクロの記録なみです。
他にうまい方法を思いつきませんでした。
作業列をＩ列にしていますので、都合が悪ければ変えてください。
Sub test()
Dim myR As Range
Dim myRow As Long
Dim c As Range
Dim myAry As Variant
Dim i As Long
Application.ScreenUpdating = False
'ワークシート関数CountIfで各氏名の表出をカウントする。
Set myR = Range("F1", Range("F65536").End(xlUp))
myRow = Range("F65536").End(xlUp).Row
With myR.Offset(0, 3)
.Value = "=CountIf($F$1:$F$" & myRow & ", F1)"
.Value = .Value
End With
'E列の値を消す
Range("E:E").ClearContents
'F3,F11,F16,F21の人に１ポイント追加し、
myAry = Array(Range("F3").Value, Range("F11").Value, Range("F16").Value, Range("F21").Value)
For i = 0 To 3
For Each c In myR
If c.Value = myAry(i) Then
With c
.Offset(0, 3).Value = .Offset(0, 3).Value + 1
End With
End If
Next
Next
'E3 , E11, E16, E21に○をつける
Range("E3 , E11, E16, E21").Value = "○"
'E26に○をつける
With Cells(26, 5)
If .Offset(0, 4).Value > .Offset(1, 4).Value Then
.Offset(1, 0).Value = "○"
Else
.Value = "○"
End If
End With
'E34,E39,E44・・・・に○をつける
For i = 34 To 531 Step 5
With Cells(i, 5)
If .Offset(0, 4).Value > .Offset(1, 4).Value Then
.Offset(1, 0).Value = "○"
Else
.Value = "○"
End If
End With
Next
'作業列の値を消す。
myR.Offset(0, 3).ClearContents
Application.ScreenUpdating = True
End Sub
|
|
ponpon
- 05/6/30(木) 0:11 -
