[[20061027165900]] 『条件付書式で…』(HK) ページの最後に飛ぶ

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

 

『条件付書式で…』(HK)

 条件式書式は通常3つまでしか条件を設定できないのですが、
 それを6つにしたいのです。
 でも、条件付書式の条件がセルに入力されている文字列を参照したい為、うまく出来ません。

 Aが入力されている場合⇒背景を赤
 Bが入力されている場合⇒背景を青
 Cが入力されている場合⇒背景を緑
 Dが入力されている場合⇒背景を黄
 Eが入力されている場合⇒背景を水色
 Fが入力されている場合⇒背景を橙

 上の内容について、条件付書式にて対応させたいのです。
 どうぞ、ご教授をお願いします。


 条件付書式ではできません
[[20050308152110]] 『条件付書式の条件は3つが限度?』(よよ)
[[20050115131721]]『条件式書式を6つやりたいんですが・・・』(sirouto)
 (dack)

 VBAを使用しないと無理のようですね。
 過去ログを参照してがんばって見ます。
 (HK)

 過去ログ参照してコードを作成したのですが、セルに新しく文字を入力しないと、
 セルの背景が変化しません。
 セルの背景を変化させたいセルには数式が入力されていて、その数式から表示される
 文字に対してセルの背景を変化させたいのです。
 どうぞ、宜しくお願いします。

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim colr As Integer
 Dim c As Variant
    If Target.Count > 1 Then Exit Sub
    If Target.Row <> 5 Then Exit Sub
        For Each c In Target
            Select Case c.Value
                Case "A"
                    colr = 35  
                Case "B"
                    colr = 37 
                Case "C"
                    colr = 41 
                Case "D"
                    colr = 39 
                Case "E"
                    colr = 50 
                Case "F"
                    colr = 40 
                Case Else
                    colr = xlNone
            End Select
            c.Interior.ColorIndex = colr
    Next c
 End Sub
 (HK)

 範囲は適当ですが、こんな感じですか?(ROUGE)
'----
Private Sub Worksheet_Calculate()
    Dim c As Range, clr As Integer
    For Each c In [A1:A10]
        Select Case c.Text
            Case "A": clr = 35
            Case "B": clr = 37
            Case "C": clr = 41
            Case "D": clr = 39
            Case "E": clr = 50
            Case "F": clr = 40
            Case Else: clr = xlNone
        End Select
        c.Interior.ColorIndex = clr
    Next
End Sub

 ROUGEさん、ありがとうございます。完璧でした。
 (HK)

 解決後なのですが、すいません。
 ↑のコードを使用するとツールバー内にある、『元に戻す』と『やり直し』の
 矢印が使用できなくなってしまいました。なぜでしょうか?
 ↑のコードを消去すると、使用できます。
 (HK)

 それはおそらく
 「マクロを実行すると『元に戻す』が使えない」
 からだと思います。

 (HANA)

 >それはおそらく
 >「マクロを実行すると『元に戻す』が使えない」
 >からだと思います。
  これはマクロの性質上解決出来ない問題なのですね。
  でしたら、コマンドボタンを使用した時に↑のコードを使用するというようには
  出来るのでしょうか?
 (HK)

 >でしたら、コマンドボタンを使用した時に↑のコードを使用するというようには
 >出来るのでしょうか?
 やればわかる。 (アカギ)


 ツール>表示>コントロールツールボックス でコマンドボタンをシートへ配置。
シートモジュールのマクロを次のように書き換えます。
 
 Private Sub test()
     Dim c As Range, clr As Integer
     For Each c In [A1:A10]
         Select Case c.Text
             Case "A": clr = 35
             Case "B": clr = 37
             Case "C": clr = 41
             Case "D": clr = 39
             Case "E": clr = 50
             Case "F": clr = 40
             Case Else: clr = xlNone
         End Select
         c.Interior.ColorIndex = clr
     Next
 End Sub

 Private Sub CommandButton1_Click()
 Call test
 End Sub
 
(みやほりん)(-_∂)b

 みやほりんさん、ありがとうございます。
 希望通りの事が出来ました。
 (HK)

 一度解決したレスなのですが、掘り起こしてしまってすいません。
 このレス内容の関係で、再度ご教授してください。

  Private Sub test()
     Dim c As Range, clr As Integer
     For Each c In [A1:A10]
         Select Case c.Text
             Case "A": clr = 35
             Case "B": clr = 37
             Case "C": clr = 41
             Case "D": clr = 39
             Case "E": clr = 50
             Case "F": clr = 40
             Case Else: clr = xlNone
         End Select
         c.Interior.ColorIndex = clr
     Next
 End Sub

 Private Sub CommandButton1_Click()
 Call test
 End Sub

 現在、↑のコードをシートモジュール内に貼り付けて、コマンドボタンを押した際に、動作するようにしているのですが、
 今のままですと、コードを記入してある、シートにしか対応がしていません。
 これを他のシートでも同様の動作をさせるようにはどうしたらよいでしょうか?
 testコードの名前を『test1,test2…』という具合に変えて、対応させたいシートモジュールに貼り付け、コマンドボタンのコードも↓の様に変更しました。

 Private Sub CommandButton1_Click()
 Call test
 Call test1
 Call test2
 End Sub

 ですが、「コンパイルエラー:Subまたは、Functionが定義されていません」とエラーが出てしまいます。
 どうか、ご教授をお願いします。
 (HK)


 標準モジュールにコードをコピペして
 Private Sub test()
を
Sub test()
にかえて、シート上に貼り付けたボタンからCallしてみたらいかがでしょうか?
                (SHIOJII)

 SHIOJIIさん、レスありがとうございます。
 SHIOJIIさんに教えてもらった通りにやった所、コマンドボタンが貼り付けてあるシートは対応出来るのですが、
 今使用しているコードはシートの指定はしてなくて、セルの場所しか指定していない為、他のシートに対応させる事が出来ません。
 どうすれば良いのでしょうか?
 (HK)

 KHさん

 ご提示の
 Call test
 Call test1
 Call test2
 で何をされたいのですか?
 (seiya)

 条件付書式をやりたいのです。
 今までは1Sheetのみ対応をさせていたのですが、それを複数Sheetに対応させたいのです。
 条件付書式の内容はどのSheetも全て同じです。
 (HK)

 こんな感じ?

 Sub test()
 Dim e As Variant, r As Range, clr As Byte
 For Each e In Array("Sheet1","Sheet2","Sheet3") '<- 必要に応じて追加・削除
     With Sheets(e).Range("a1:a10")
         .Interior.ColorIndex = xlNone
         For Each r In .Cells
             Select Case r.Text
                 Case "A" : clr = 35
                 Case "B" : clr = 37
                 Case "C" : clr = 41
                 Case "D" : clr = 39
                 Case "E" : clr = 50
                 Case "F" : clr = 40
             End Select
             r.Interior.ColorIndex = clr
         Next
     End With
 Next
 End Sub
 (seiya)

 seiyaさん、希望通りの事が出来ました。
 ですが、もう少し教えて下さい。私の説明不足だったのですが、
 今は、条件付書式を対応させるセルは、どのSheetでも同じセルにしか対応が出来ていませんが、
 それをシート毎にセルを指定して対応させる事は出来るのでしょうか?

 また、条件付書式に設定していない文字が入力されていても、
 『Case "F" : clr = 40』
 ↑の色がセルに塗られてしまいます。
 (HK)


 1) 可能です
 2) 状況が良く理解できません。もう少し具体的に説明してください。
 (seiya)

 また、・・・・・の質問のほうだけ^^

                 Case "F" : clr = 40
                 Case Else: clr = xlNone 'ここ追加
             End Select
 かな?(dack)

 こんな感じで....
 myListを編集してください

 Sub test()
 Dim myList, r As Range, i As Integer, clr as Integer
 myList = Array(Array("Sheet1","A1:A10"),Array("Sheet2","B1:B10"),Array("Sheet3","C1:C10"))
 For i = 0 To UBound(myList)
     With Sheets(myList(i)(0)).Range(myList(i)(1))
         .Interior.ColorIndex = xlNone
         clr = xlNone
         For Each r In .Cells
             Select Case r.Value
                 Case "A" : clr = 35
                 Case "B" : clr = 37
                 Case "C" : clr = 41
                 Case "D" : clr = 39
                 Case "E" : clr = 50
                 Case "F" : clr = 40
             End Select
             If clr <> xlNone Then r.Interior.ColorIndex = clr
             clr = xlNone
         Next
     End With
 Next
 End Sub
 (seiya)


 seiya さ〜ん
 Select Case ?
 抜けてますよ。

 Select Case r
 でいいのかな。
 (Matta)

 Mattaさん、どうもです。
 コード修正しました。
 (seiya)

 レス遅くなりました。
 seiyaさん。本当にありがとうございます☆
 完璧でした(^_^)
 (HK)

コメント返信:

[ 一覧(最新更新順) ]


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