| |
おはようございます。
>同点の場合が有るので、人名ｒも入るのかな
とHirofumiさんがおっしゃっていますね！！
これを考慮すると・・・。
> Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ
>7 人名a 23 人名a 111
>8 人名b 12 人名b 222
>9 人名c 14 人名c 121
>10 人名d 21 人名d 212
>11 人名e 22 人名e 311
>12 人名f 111 人名f 123
>13 人名g 222 人名g 321
>14 人名h 333 人名h 221
>15 人名i 444 人名i 234
>16 人名j 555 人名j 432
>17 人名k 666 人名k 101
>18 人名l 777 人名l 555
>19 人名m 888 人名m 666
>20 人名n 999 人名n 777
>21 人名o 129 人名o 120
>22 人名p 138 人名p 200
>23 人名q 397 人名q 146
>24 人名r 222 人名r 450
これをＢ：Ｃ列をＣ列、Ｆ：Ｇ列をＧ列で降順に並べ替えると
'=====================================================
Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ
７ 人名n 999 人名n 777
８ 人名m 888 人名m 666
９ 人名l 777 人名l 555
１０ 人名k 666 人名r 450
１１ 人名j 555 人名j 432
１２ 人名i 444 人名g 321
１３ 人名q 397 人名e 311
１４ 人名h 333 人名i 234
１５ 人名r 222 人名b 222
１６ 人名g 222 人名h 221
１７ 人名p 138 人名d 212
１８ 人名o 129 人名p 200
１９ 人名f 111 人名q 146
２０ 人名a 23 人名f 123
２１ 人名e 22 人名c 121
２２ 人名d 21 人名o 120
２３ 人名c 14 人名a 111
２４ 人名b 12 人名k 101
となります（ここまでは出来るのですよね？）
このデータに対して、
標準モジュールに
'==================================================================
Sub main()
Dim rng1 As Range
Dim rng2 As Range
Dim rw1 As Long
Dim rw2 As Long
Const 調査順位 As Long = 9
On Error Resume Next
With Range("c7", Cells(Rows.Count, 3).End(xlUp))
rw1 = Evaluate("max(if(" & .Address & "=large(" _
& .Address & "," & 調査順位 & _
"),row(" & .Address & ")))")
If Err.Number <> 0 Then rw1 = .Row + .Rows.Count - 1
End With
Err.Clear
With Range("g7", Cells(Rows.Count, 7).End(xlUp))
rw2 = Evaluate("max(if(" & .Address & "=large(" _
& .Address & "," & 調査順位 & _
"),row(" & .Address & ")))")
If Err.Number <> 0 Then rw2 = .Row + .Rows.Count - 1
End With
Range("b:b,f:f").FormatConditions.Delete
Set rng1 = Range("b7:b" & rw1)
Set rng2 = Range("f7:f" & rw2)
With rng1
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=countif(" & rng2.Address(, , xlR1C1) & ",rc)"
.FormatConditions(1).Interior.ColorIndex = 6
End With
With rng2
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=countif(" & rng1.Address(, , xlR1C1) & ",rc)"
.FormatConditions(1).Interior.ColorIndex = 6
End With
On Error GoTo 0
End Sub
人名rまで塗りつぶし対象になります。
これも試してみてください。
|
|
ichinose
- 06/10/23(月) 8:00 -
