[[20140916214120]] 『条件付き書式設定』(mirumi) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『条件付き書式設定』(mirumi)

いつも拝見させていただいてます
条件付き書式につて教えていただけたら幸いです

Y3〜Y20まで数値が入ってまして
上位3位まで色付けをしています

困っているのは
同じ数値の場合色は同じで構わないのですが
 同じ数値が2個以上ある場合

2番目もしくは3番目の数値に色が付きません

どのようにすれば良いのでしょうか
よろしくお願いいたします

< 使用 Excel:Excel2013、使用 OS:Windows8 >


 A 100
 B 100
 C 100
 D 101

 こういう場合、Dは2番目ではなく、4番目、というのが正しいです。
 Dを2番目としたい、ということでしょうか?
(カリーニン) 2014/09/16(火) 21:51

 関数は弱いので当てはまるのかわかりませんが、参考になると思います。

http://officetanaka.net/excel/function/function/rank.htm
(カリーニン) 2014/09/16(火) 21:55


カリーニン様
ご指導有難う御座います

>Dを2番目としたい、ということでしょうか?
その通りでございます

この様にするにはどのようにすれば良いのでしょうか?
マクロは 自動記録くらいしか使えないものでして

大変我儘だと思いますが
ご指導していただけないでしょうか
よろしくお願いいたします

(mirumi) 2014/09/16(火) 22:02


 21:55のレスのリンク先は複数の条件で重複無しの順位付けする方法でしたね。
 マクロなら出来ないこともないですが(ちょっと考えてみましたが行き詰ってます・・・)、関数等となると
 現状では分かりません。お力になれなくてすみません。
(カリーニン) 2014/09/16(火) 23:06

カリーニン様
ご迷惑かけて申し訳ございません

お気持ちだけで十分です
本当にありがとうございます
又何かありましたら
よろしくお願いいたします
(mirumi) 2014/09/16(火) 23:10


 一応VBA版できました。
 選択セルの一列右のセルに順位を書き出します。
 テスト用ブックでお試しください。

 ※完全に条件付き書式から離れた回答です。

 Sub test()
  Dim c As Range
  Dim r As Range
  Dim mydic As Object
  Dim mydicB As Object
  Dim itm As Variant
  Dim kys As Variant
  Dim i As Integer
   Set r = Selection
   Set mydic = CreateObject("Scripting.Dictionary")
   For Each c In r
    If mydic.exists(c.Value) Then
    Else
       mydic.Add c.Value, ""
    End If
   Next c
   kys = mydic.keys
   Set mydicB = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(kys) + 1
    mydicB.Add WorksheetFunction.Small(kys, i), i
   Next i
   For Each c In r
    c.Offset(, 1).Value = mydicB(c.Value)
   Next c
   mydic.RemoveAll
   Set mydic = Nothing
   mydicB.RemoveAll
   Set mydicB = Nothing
 End Sub
(カリーニン) 2014/09/16(火) 23:41

 ユーザー定義関数を使って指定の順位のセルに条件付き書式を設定する方法です。

 条件付き書式/A1-A17で順位が1のセルに色を付ける場合
 =myrank($A$1:$A$17,A1)=1

 '標準モジュール
 Function myrank(ByVal r As Range, c As Range) As Long
 Dim cc As Range
  Dim mydic As Object
  Dim mydicB As Object
  Dim itm As Variant
  Dim kys As Variant
  Dim i As Integer
   Set mydic = CreateObject("Scripting.Dictionary")
   For Each cc In r
    If mydic.exists(cc.Value) Then
    Else
       mydic.Add cc.Value, ""
    End If
   Next cc
   kys = mydic.keys
   Set mydicB = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(kys) + 1
    mydicB.Add WorksheetFunction.Small(kys, i), i
   Next i
   myrank = mydicB(c.Value)
   mydic.RemoveAll
   Set mydic = Nothing
   mydicB.RemoveAll
   Set mydicB = Nothing
 End Function
(カリーニン) 2014/09/17(水) 00:05

 上位3位は1位2位3位で色が違うのか、全部同じ色なのか?

 違う場合。
 条件付き書式で
 ・指定の値を含むセルだけ書式設定
 ・「セルの値」「次の値に等しい」
 1位
 =MAX($Y$3:$Y$20)
 2位
 =LARGE($Y$3:$Y$20,COUNTIF($Y$3:$Y$20,"="&MAX($Y$3:$Y$20))+1)
 3位
 =LARGE($Y$3:$Y$20,COUNTIF($Y$3:$Y$20,">="&LARGE($Y$3:$Y$20,COUNTIF($Y$3:$Y$20,"="&MAX($Y$3:$Y$20))+1))+1)

 3位とも同じ色にする場合
 条件付き書式で
 ・指定の値を含むセルだけ書式設定
 ・「セルの値」「次の値以上」
 に設定
 =LARGE($Y$3:$Y$20,COUNTIF($Y$3:$Y$20,">="&LARGE($Y$3:$Y$20,COUNTIF($Y$3:$Y$20,"="&MAX($Y$3:$Y$20))+1))+1)
 を入力。

 無理やりw

(1111) 2014/09/17(水) 09:20


 順位によって色を変えるのかどうか、というのもそうですけど、
 数字が大きい方が上位なのか、小さい方が上位なのか、
 Y3:Y20は全部数字で埋まっているのか、空白もあるのか、ということもわからないですね。
 空白がある場合、その空白は全くの未入力なのか数式によるものなのか、ということもはっきりしてほしい。

 順位が違っても色は同じ
 数字が大きい方が上位
 空白がくることもあるが、それは未入力(数式によるものではない)
 だとして。

 Y3:Y20を選択して条件付き書式(数式を使って、書式設定するセルを決定)

 =AND(Y3<>"",SUMPRODUCT(($Y$3:$Y$20>=Y3)/COUNTIF($Y$3:$Y$20,$Y$3:$Y$20&""))<=3)

 条件付き書式だったら、SUMPRODUCT → SUM でもいいかな?
(笑) 2014/09/17(水) 16:11

 作業列を使ってもよければ

 Z3 =IF(COUNTIF($Y$3:Y3,Y3)=1,Y3,"")  

 Z20までコピー

 Y3:Y20を選択して条件付き書式(数式を使って、書式設定するセルを決定)

 =RANK(Y3,$Z$3:$Z$20)<=3

 順位が違っても同じ色で
 数字が大きい方が上位だとして。
(笑) 2014/09/17(水) 17:07

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.