[[20090910133727]]　『複数の条件付書式のような？』（はなはな）　ページの最後に飛ぶ

『複数の条件付書式のような？』（はなはな）

仮に、Ａ列に2009年の大学名が3行ごとに1位から5位まで順位ごとに文字の色を変えて入力されています。
C列には同じように2008年の大学名が入力されています。

2009年の1位から5位までの大学名と一致する2008年の大学名を、2009年の大学名と同じ色で表示したいのですが、どうすればよいのでしょうか？

うまく表示できないとは思いますが、以下のような表示です。

2009年度　　　－－－　　　2008年度

Ａ大学　　　　－－－　　　Ｂ大学

Ｂ大学　　　　－－－　　　Ｃ大学

Ｃ大学　　　　－－－　　　Ａ大学

Ｄ大学　　　　－－－　　　Ｅ大学

Ｅ大学　　　　－－－　　　Ｄ大学

※Ａ大学は2008年度も2009年度も赤文字、Ｂ大学は青文字、Ｃ大学は黄色文字、Ｄ大学は茶色、Ｅ大学は緑と言った感じです。

 関数では色の情報まで反映できませんので、VBAになると思います。
 でも5個くらいであれば手作業でいいじゃないでしょうか。
 (ミニドナ) 2009/9/10 14:39

例として挙げたのは一部で、実際には、ひとつの大学を設定して、そのライバル大学が5位まで表示されるデータです。なので、大学ごとに毎回ＡからＥまでの大学名は変わってきます。
つまり、セルが2009年度1位の大学名が常に赤、2位が青････、2008年度の列では2009年度1位の大学名は1位でなくても赤といった感じです。（大学名に色を設定するのではなく、2009年度の順位ごとに大学の色が設定されるわけです。わかりにくい説明でごめんなさい。）

 はい、理解しています。

 ですので、
 >関数では色の情報まで反映できませんので、VBAになると思います。
 と回答しました。

 >でも5個くらいであれば手作業でいいじゃないでしょうか。
 は、データが少ないなら手作業でも早いよ？と言う意味です。

 コメントの際は
 ←ココに半角スペースを入れると入力どおりに表示されます。
 また、最後にHNは必ずつけてくださいね。
 (ミニドナ) 2009/9/10 15:20

以前、数値だけの表での複数の条件付書式設定をVBAで解決していただいたことがあるので、今回も教えていただきたいと思いました。
データは大学ごとに毎回変わるので、かなりの量になります。
（はなはな）

 VBAで解決されたいのでしたら、シートの構成をもっと詳しく書いたり
 どのタイミングで実行するのかとかを書いた方が解答が出やすいと思いますよ
 後々に変更になると面倒ですので。
 （ｍｏｍｏ）

上手に表示できるか自信がありませんが、トライしてみますのでご教授よろしくお願いします。

	[A]　　　　[B]　　　　[C]　　　　[D]　　　　[E]　　　　[F]　　　　[G]	
 [1]　　キー大学
 [2]　　順位　　2007大学名　　数値　　2008大学名　　数値　　2009大学名　　数値
 [3]　　1位　　　BB大学　　　　55　　　AA大学　　　　54　　　AA大学　　　　53
 [4]　　2位　　　AA大学　　　　56　　　CC大学　　　　53　　　BB大学　　　　55
 [5]　　3位　　　GG大学　　　　56　　　BB大学　　　　53　　　CC大学　　　　55
 [6]　　4位　　　FF大学　　　　56　　　EE大学　　　　53　　　DD大学　　　　55
 [7]　　5位　　　EE大学　　　　56　　　FF大学　　　　53　　　EE大学　　　　55

説明：[A1]セルにキー校を入力すると、その大学の過去3年間のライバル校が上位5校まで表示されます。

 　　　数値列の数字はダミーです。（大学列のみが連続してはないことを示すため）
 　　　上記の例なら、[F3]セル文字は赤色、以下[F4]青色、[F5]黄色、[F6]茶色、
 　　　[F7]緑色で表示。
 　　　[F]列に倣って、[B][D]列の大学名もAA大学であれば赤色、[F]列に登場しない
 　　　大学名はそのまま。（上記の例でいえば、FF大学やGG大学）
 以上、よろしくお願いします。
　(はなはな）

 単純にループしていますが、こんな感じ?　　(Hatch)
Sub test()
Dim c As Range
    Range("B3:B7").Interior.ColorIndex = xlNone
    For Each c In Range("B3:B7")
     iroduke c
    Next c
    Range("D3:D7").Interior.ColorIndex = xlNone
    For Each c In Range("D3:D7")
     iroduke c
    Next c
End Sub
Sub iroduke(c As Range)
        Select Case c.Value
            Case Range("F3").Value
                c.Interior.ColorIndex = Range("F3").Interior.ColorIndex
            Case Range("F4").Value
                c.Interior.ColorIndex = Range("F4").Interior.ColorIndex
            Case Range("F5").Value
                c.Interior.ColorIndex = Range("F5").Interior.ColorIndex
            Case Range("F6").Value
                c.Interior.ColorIndex = Range("F6").Interior.ColorIndex
            Case Range("F7").Value
                c.Interior.ColorIndex = Range("F7").Interior.ColorIndex
        End Select
End Sub

 別案です。

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Long, myColor As Variant
  If Target.Address <> "$A$1" Then Exit Sub
  myColor = Array(3, 5, 6, 53, 10)
  With Me
    .Range("B3:F7").Font.ColorIndex = 0
    On Error Resume Next
    For i = 3 To 7
      myStr = Me.Range("F" & i).Value
      .Range("B" & Application.Match(myStr, .Columns("B"), 0)).Font.ColorIndex = myColor(i - 3)
      .Range("D" & Application.Match(myStr, .Columns("D"), 0)).Font.ColorIndex = myColor(i - 3)
      .Range("F" & i).Font.ColorIndex = myColor(i - 3)
    Next i
    On Error GoTo 0
  End With
  End Sub

 （ｍｏｍｏ）

Hatch様、momo様、回答ありがとうございます。
折角教えてくださっているのに、私の実力が伴わないため実行できません。

まず、Hatch様案

 　コードをコピーしてマクロを実行したのですが不変でした。
 　貼り付ける場所が違うのでしょうか？『Sheet』と『Thisworkbook』のどちらでもチャレンジしました。

次にmomo様案

 　『Private Sub Worksheet_Change･･･』というのはどういう意味なのでしょう？
 　マクロメニューに何も表示されないので、どの段階で変化するのでしょう？
 　かなりおバカな質問だと思いますが、教えていただけたら嬉しいです。

やはり、マクロはもっと勉強しないといけないとつくづく思います。例えば『Private Sub Work･･･』がどんな意味なのか理解するには、どのような勉強をすればいいのでしょう。
お時間があれば、ご回答くださったコードの解説をしていただけたら幸いです。
（はなはな）

 あらかじめF列のセルが塗りつぶしてあるものと思っていました。
 前のコードはF列が塗りつぶしてないと、変化がありませんね(^^ゞ
 以下のように書き換えれば(ちょっと荒っぽいですけど)、既定のmycolorで塗りつぶされます。
 このコードは標準モジュールに記述して、必要な時実行します。　(Hatch)
Sub test()
Dim c As Range, i As Long
Dim mycolor As Variant
    mycolor = Array(3, 5, 6, 53, 10)
    For i = 1 To 5
        Range("F" & i + 2).Interior.ColorIndex = mycolor(i - 1)
    Next i
    Range("B3:D7").Interior.ColorIndex = xlNone
    For Each c In Range("B3:D7")
        Select Case c.Value
            Case Range("F3").Value
                c.Interior.ColorIndex = mycolor(0)
            Case Range("F4").Value
                c.Interior.ColorIndex = mycolor(1)
            Case Range("F5").Value
                c.Interior.ColorIndex = mycolor(2)
            Case Range("F6").Value
                c.Interior.ColorIndex = mycolor(3)
            Case Range("F7").Value
                c.Interior.ColorIndex = mycolor(4)
        End Select
    Next c
End Sub

 Hatch様すばやい回答ありがとうございます。
 ただひとつ、応用として教えていただきたいのですが、色をつけているのはセルではなくセルに入力されている文字なんです。
 セルのパターンだと色によって文字が判読しにくいため、文字色に変化をつけたかったのですが･･･
 自分なりにチャレンジして、セル色が『Interior.colorindex』ならフォント色は『Font.Colorindex』に置き換えてみたのですが、ダメでした。
 申しわけありませんが、セル色ではなくf列のセルに設定した文字色が反映するにはどうしたらいいか再度教えてください。
（はなはな）

 横から割り込みながら貼り付けてみよう……
[[20050115131721]]
マクロの記録を活用すると、応用できると思いますよ。
　
追記
ポイントはアレか、「フォントの色」を「自動」に切り替えた時に
マクロの記録ではどのように記述されるのか。
（ご近所PG）既に試してるかも知れないけど

 私のコードは、該当するシートのオブジェクトモジュールに貼り付けてください。
 すると、そのシートのA1セル、つまりキー大学を変更するかF2でEnterすれば
 勝手に色づけします。
 （ｍｏｍｏ）

 ↓のコードを参考に書き換えると次のような感じ。
[[20050115131721]]
ちょっとだけ、弄っていますが・・・　(Hatch)
Sub test3()
Dim c As Range, i As Long
Dim mycolor As Variant
Dim colr As Integer, x As Variant
    mycolor = Array(3, 5, 6, 53, 10)
    For i = 3 To 7
        Range("F" & i).Font.ColorIndex = mycolor(i - 3)
    Next i
    x = Range("F3:F7").Value
    For Each c In Range("B3:D7")
        If Not Application.Intersect(c, Range("B:B,D:D")) Is Nothing Then
            Select Case c.Value
                Case x(1, 1)
                    colr = mycolor(0)
                Case x(2, 1)
                    colr = mycolor(1)
                Case x(3, 1)
                    colr = mycolor(2)
                Case x(4, 1)
                    colr = mycolor(3)
                Case x(5, 1)
                    colr = mycolor(4)
                Case Else
                    colr = 0
            End Select
            c.Font.ColorIndex = colr
        End If
    Next c
End Sub

 momo様、Hatch様おかげさまで無事解決しました。
 実際に作成した表は2行おきに大学名が表示されるので、回答してくださったコードを参考に書き換えたら、思い通りの表になりました。
 これまで、いただいたコードをそのまま使ってばかりいましたが、コードの内容を解読してアレンジしていけるように、これから少しずつ勉強していきたいと思います。
 毎回、ここで助けていただいて本当にありがたい『エクセルの学校』です。
 （はなはな）

コメント返信：

[ 一覧(最新更新順) ]

[[20090910133727]] 『複数の条件付書式のような？』（はなはな） ページの最後に飛ぶ

[[20090910133727]]　『複数の条件付書式のような？』（はなはな）　ページの最後に飛ぶ