[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数の条件付書式のような?』(はなはな)
仮に、A列に2009年の大学名が3行ごとに1位から5位まで順位ごとに文字の色を変えて入力されています。
C列には同じように2008年の大学名が入力されています。
2009年の1位から5位までの大学名と一致する2008年の大学名を、2009年の大学名と同じ色で表示したいのですが、どうすればよいのでしょうか?
うまく表示できないとは思いますが、以下のような表示です。
2009年度 −−− 2008年度
A大学 −−− B大学
B大学 −−− C大学
C大学 −−− A大学
D大学 −−− E大学
E大学 −−− D大学
※A大学は2008年度も2009年度も赤文字、B大学は青文字、C大学は黄色文字、D大学は茶色、E大学は緑と言った感じです。
関数では色の情報まで反映できませんので、VBAになると思います。 でも5個くらいであれば手作業でいいじゃないでしょうか。 (ミニドナ) 2009/9/10 14:39
はい、理解しています。
ですので、 >関数では色の情報まで反映できませんので、VBAになると思います。 と回答しました。
>でも5個くらいであれば手作業でいいじゃないでしょうか。 は、データが少ないなら手作業でも早いよ?と言う意味です。
コメントの際は ←ココに半角スペースを入れると入力どおりに表示されます。 また、最後にHNは必ずつけてくださいね。 (ミニドナ) 2009/9/10 15:20
VBAで解決されたいのでしたら、シートの構成をもっと詳しく書いたり どのタイミングで実行するのかとかを書いた方が解答が出やすいと思いますよ 後々に変更になると面倒ですので。 (momo)
[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
(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すれば 勝手に色づけします。 (momo)
↓のコードを参考に書き換えると次のような感じ。 [[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行おきに大学名が表示されるので、回答してくださったコードを参考に書き換えたら、思い通りの表になりました。 これまで、いただいたコードをそのまま使ってばかりいましたが、コードの内容を解読してアレンジしていけるように、これから少しずつ勉強していきたいと思います。 毎回、ここで助けていただいて本当にありがたい『エクセルの学校』です。 (はなはな)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.