[[20120524220149]]　『シート見出しの色をマクロで』（素人）　ページの最後に飛ぶ

『シート見出しの色をマクロで』（素人）エクセル２０１０

 以前ここで教えていただきありがとうございましたm(__)m
 それで　一つ付け加えて頂きたくて教えてくださいm(__)m

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 Select Case Sh.Range("D1")
 Case "インテリア"
Sh.Tab.ColorIndex = 10
 Case "(株)松本"
Sh.Tab.ColorIndex = 5
 Case "栄建設(有)"
Sh.Tab.ColorIndex = 7
 Case "(有)橋本"
Sh.Tab.ColorIndex = 9
 Case "荒浜"
Sh.Tab.ColorIndex = 29
 Case "谷建築"
Sh.Tab.ColorIndex = 46
 Case "工賃"
Sh.Tab.ColorIndex = 16
 Case "(株)大組"
Sh.Tab.ColorIndex = 11
 Case "まつおか"
Sh.Tab.ColorIndex = 12
 Case "(株)建築"
Sh.Tab.ColorIndex = 3
 Case "(有)ゾーン"
Sh.Tab.ColorIndex = 25
 End Select
 End Sub

 となっていますが　上にある11の会社名以外が入った時には　15番の色を付けたいのですが
 どうやったらいいでしょうかm(__)m　１１からまだ　今後増えていくと思いますが
 とにかく　それ以外の言葉が入った時には　15番の色を　付けたいのですが
 すみませんが教えてください　m(__)m
 宜しくお願い致しますm(__)m

 Case Else
 以下にヒントを。

 Sub hint()
    Dim s As String

    s = "ABC"

    Select Case s
        Case "AAA"
            MsgBox "AAAです"
        Case "BBB"
            MsgBox "BBBです"
        Case "CCC"
            MsgBox "CCCです"
        Case Else
            MsgBox "その他です"
    End Select

 End Sub

 (ぶらっと)

ぶらっとさん　ありがとうございますm(__)m　

 すみません　知識がなく(>_<)　すみません(>_<)　よく意味が判らず申し訳ないですm(__)m
 Sub hint()
    Dim s As String

    s = "ABC"

    Select Case s
        Case "AAA"
            MsgBox "AAAです"
        Case "BBB"
            MsgBox "BBBです"
        Case "CCC"
            MsgBox "CCCです"
        Case Else
            MsgBox "その他です"
    End Select

 End Sub

 これを　先に作ったものの下に　張り付けましたが　出来ませんでした(>_<)　
 AAA　とかBBBとかは　このまま入れずに　会社名に置き換える？でしょうかm(__)m
 今教えて頂いたのを　追加して　D1　に　例えばですが　リンゴ会社　と入れてみましたが　シート見出しの色は　何も付きません(>_<)　　
 本当にすみません　教えてくださいm(__)m　何卒宜しくお願い致しますm(__)m

 いやぁ・・・・（汗）　ヒントということだったんだけどね。

 Select Case 比較対象のもの

    Case ○○　　　　比較対象が　○○　だったら
      そのときの処理
    Case ●●　　　　比較対象が　●●　だったら
      そのときの処理
    Case ◎◎　　　　比較対象が　◎◎　だったら
      そのときの処理

      '
      '必要なだけ、この記述をして
      '

    Case Else　　　　比較対象が　上で比較したもの【以外】だったら
      そのときの処理

 End Select

 だから、今、持っているコードの　End Select の前に

 Case Else
   Sh.Tab.ColorIndex = 15

 こう、追加してもらおうとしたんだけどな。

 (ぶらっと)

（素人）ぶらっとさんm(__)m　いつもありがとうございます(^_^)　m(__)m

 出来ました＼(~o~)／　でも　さぞかし呆れられた(~_~;)　と思いました(~_~;)　すみません(~_~;)
 意味が　理解できず…　(>_<)　関数とかマクロって難しいですねー　何か凄い勉強になります(*^_^*)
 どうもありがとうございました(^_^)　m(__)m　m(__)m　m(__)m
 感謝いたします(*^_^*)

 ちょっと記になったので・・・・。

 >Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 >    Select Case Sh.Range("D1") 
 >　　　　　・
 >　　　　　・

 このChangeイベント、セルD1に入力した時だけ処理をするのではないこと、理解されていますか？
 セルD1以外の入力でも常にセルD1の値でCase文が作動しています。

 実際、試してみると殆どストレスはありませんが、処理の流れを知っていての上記のコードという
 判断なら良いのですが、知らないと上記の記述だと大きいストレスが発生する場合もあるので
 注意してください。

 >１１からまだ　今後増えていくと思いますが

 これは、Case節を増やしていく予定がある　ということですね？

 プログラムの変更回数は、プログラムの品質を落とす要因になっています。
 よって、作成時に将来を予測し、変更を少なくする手法を選択しなければなりません。

 Case文の理解を深めることは良いことです。が、既に

 >今後増えていく
 という予想がたつならば、増えていってもコードの変更をしなくても済む方法を
 見つけることも必要だと思いますが、検討してみてください

 方法としては、どこかのシートに一覧をつくり、
 その表をVlookup等で検索する方法が考えられます。
 この方法をとると、データが増えてもコードの変更は要らなくなります。

 ichinose

 ichinoseさんから貴重なアドバイスがでているので、是非、内容を理解してね。
 で、将来の追加も考えたときの対処案として、以下も参考に。
 マスタというシートを作って、A列に会社名、で、そのセルの背景色をその会社名のシートタブにしたい色にしておく。

 で、コードを以下のように。
 こうしておけば将来の追加時には、マスタシートに会社を追加し、そのセルに好みの色をつけるだけで
 コード変更は不要になる。

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Variant
    Dim myIdx As Long
    If Not Intersect(Target, Sh.Range("D1")) Is Nothing Then
        With Sheets("マスタ")
            x = Application.Match(Sh.Range("D1").Value, .Columns("A"), 0)
            myIdx = 15  'その他
            If IsNumeric(x) Then myIdx = .Cells(x, "A").Interior.ColorIndex
            Sh.Tab.ColorIndex = myIdx
        End With
    End If
 End Sub

 (ぶらっと)

		(素人）	ichinoseさん　ぶらっとさん　ありがとうございます(^_^)
 上の　マクロのを入れてやってみました(^_^)　うまくできました(^_^)　出来たので感動しました～～＼(~o~)／
 そこでですが　一つ気が付いたのですが　D１セルに　入れた言葉を消しても　シート見出しの色は消えないのですが
 D1を消したら　見出しの色もまた　空白に戻り…　また別の会社名に変更したら　その見出しの色も　それに伴った色に変更になる…	
 消したら　またシートタグの色も消える…　などというのは　出来るものでしょうかm(__)m
 こうなっていると便利だな　などと素人考えで　使っていて思ってしまいました(~_~;)
 会社名を入れ間違えたりすると　シート見出しの色を　いったん透明にしてから　またD1　に会社名を入れなおす…
 という作業なので　パッと消えたり　パっと変更になればいいな～などと　思ってしまいました(~_~;)

 これって出来るものでしょうかm(__)m　すみませんが　教えてください　何卒宜しくお願い致しますm(__)m

 じゃぁ

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Variant
    Dim myIdx As Long
    If Not Intersect(Target, Sh.Range("D1")) Is Nothing Then
        With Sheets("マスタ")
            myIdx = xlNone
            If Len(Sh.Range("D1").Value) > 0 Then
                x = Application.Match(Sh.Range("D1").Value, .Columns("A"), 0)
                myIdx = 15  'その他
                If IsNumeric(x) Then myIdx = .Cells(x, "A").Interior.ColorIndex
            End If
            Sh.Tab.ColorIndex = myIdx
        End With
    End If
 End Sub

 (ぶらっと)

(素人）　ぶらっとさ～～～～ん＼(~o~)／　出来ましたよ～～～(*^_^*)　＼(~o~)／

 本当に　ありがとうございます～～　凄いです～～＼(~o~)／
 感謝でいっぱいです～～m(__)m　　本当に　どうもありがとうございました(^_^)
 感謝いたします　m(__)m　m(__)m　m(__)m　＼(~o~)／
 ありがとうございました　＼(~o~)／

コメント返信：

[ 一覧(最新更新順) ]

[[20120524220149]] 『シート見出しの色をマクロで』（素人） ページの最後に飛ぶ

[[20120524220149]]　『シート見出しの色をマクロで』（素人）　ページの最後に飛ぶ