Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


38187 / 76732 ←次へ | 前へ→

【43688】Re:条件2個つきのセルの色付けについて
発言  ichinose  - 06/10/23(月) 8:00 -

引用なし
パスワード
   おはようございます。
>同点の場合が有るので、人名rも入るのかな
とHirofumiさんがおっしゃっていますね!!
これを考慮すると・・・。


>   B  C  D  E  F  G
>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

これをB:C列をC列、F:G列をG列で降順に並べ替えると

'=====================================================
     B    C    D    E    F    G
 7  人名n    999            人名n    777
 8  人名m    888            人名m    666
 9  人名l    777            人名l    555
10  人名k    666            人名r    450
11  人名j    555            人名j    432
12  人名i    444            人名g    321
13  人名q    397            人名e    311
14  人名h    333            人名i    234
15  人名r    222            人名b    222
16  人名g    222            人名h    221
17  人名p    138            人名d    212
18  人名o    129            人名p    200
19  人名f    111            人名q    146
20  人名a    23            人名f    123
21  人名e    22            人名c    121
22  人名d    21            人名o    120
23  人名c    14            人名a    111
24  人名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まで塗りつぶし対象になります。

これも試してみてください。

1 hits

【43672】条件2個つきのセルの色付けについて ミク 06/10/22(日) 17:54 質問
【43673】Re:条件2個つきのセルの色付けについて かみちゃん 06/10/22(日) 17:57 発言
【43677】Re:条件2個つきのセルの色付けについて ミク 06/10/22(日) 18:15 質問
【43678】Re:条件2個つきのセルの色付けについて かみちゃん 06/10/22(日) 18:40 発言
【43680】Re:条件2個つきのセルの色付けについて ミク 06/10/22(日) 19:26 質問
【43685】Re:条件2個つきのセルの色付けについて かみちゃん 06/10/22(日) 20:31 発言
【43686】Re:条件2個つきのセルの色付けについて ponpon 06/10/22(日) 23:03 発言
【43688】Re:条件2個つきのセルの色付けについて ichinose 06/10/23(月) 8:00 発言
【43737】Re:条件2個つきのセルの色付けについて ミク 06/10/24(火) 12:41 お礼
【43681】Re:条件2個つきのセルの色付けについて ichinose 06/10/22(日) 19:30 発言
【43682】Re:条件2個つきのセルの色付けについて ミク 06/10/22(日) 19:52 質問
【43683】Re:条件2個つきのセルの色付けについて ichinose 06/10/22(日) 20:06 発言
【43676】Re:条件2個つきのセルの色付けについて Kein 06/10/22(日) 18:12 回答
【43687】Re:条件2個つきのセルの色付けについて Hirofumi 06/10/22(日) 23:05 回答

38187 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free