Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
VBA シートの見出し範囲指定の色付け
投稿日時: 19/06/09 15:29:09
投稿者: 園 日暮

いつもお世話になります。
 
下記のVBAの構文でシート名で「1〜12」範囲のみに限り色付けを
をしたいです。
例 今月は六月ですので シート名「6」 に色がついています。
 
下記の構文に範囲指定をどうすればいいですかご指導お願いいたします。
 
 
構文
Private Sub Workbook_Open()
 Dim mySheet As Worksheet
 For Each mySheet In Worksheets
     mySheet.Tab.ColorIndex = xlNone
     If mySheet.Name = Format(Now(), "m") Or mySheet.Name = Format(Now(), "m") Then
         mySheet.Tab.ColorIndex = 3
     End If
 Next
 End Sub

回答
投稿日時: 19/06/09 16:20:17
投稿者: mattuwan44

Private Sub Workbook_Open() 
    Dim ws As Worksheet 
    Dim s As String 
    Dim i As Long 
 
    For Each ws In Me.Worksheets 
        s = ws.Name 
        If IsNumeric(s) Then 
            i = CLng(s) 
            If i > 0 And i < 13 Then 
                ws.Tab.Color = vbRed 
            Else 
                ws.Tab.ColorIndex = xlColorIndexNone 
            End If 
        End If 
    Next 
End Sub 

  
   
こんな感じですかね。
   
シート名を数値と読んで1から12の範囲にあるかの判定ですから、
まずは、シート名が数値に変換可能か IsNumeric関数で評価してみます。
現状のコードのように、
文字列で比較すると、○○より大きいなどの判定が正しく出来ない可能性がありますので、
数値に変換可能ならば、数値(整数)に変換してから、
0より大きくて、そして、13より小さいかを再度評価します。
その結果が真ならば、赤く色を付け、
偽ならば、色を無しにします。
もちろん条件式は「1以上で、12以下」としてもいいですが、
文字をタイプする数を横着してみました^^;
もし、シート名が
1,2,3、、、ではなく、
1月、2月、3月、、、ならば、
Clng関数をVal関数に変えることで、数値に変換可能になります。
   
あと、
mySheet.Name = Format(Now(), "m") Or mySheet.Name = Format(Now(), "m")
↑同じ比較式をOrで繋いでますよね?意味がないかと思います。
多分試行錯誤の結果だとは思いますが。。。
   
それと、
mySheet.Tab.ColorIndex = xlNone
とされてます。マクロの記録をするとそう出るかも知れませんが、
色なしの定数は、xlColorIndexNoneと指定するのが一応決まりです。
ヘルプでご確認願います。
実体としては、どちらも数値の0の意味なので、どちらを使っても不都合はありません。
一応知識として知っておいてもいいかなと言及しておきます。
   
また、こういった場合にはIf文ではなくSelect Case文で書くと、
あとで読みやすいかもです。
  
Private Sub Workbook_Open() 
    Dim ws As Worksheet 
    Dim s As String 
 
    For Each ws In Me.Worksheets 
        s = ws.Name 
        If IsNumeric(s) Then 
            Select Case CLng(s) 
                Case 1 To 12 
                    ws.Tab.Color = vbRed 
                Case Else 
                    ws.Tab.ColorIndex = xlColorIndexNone 
            End Select 
        End If 
    Next 
End Sub 

  
この辺は個人のお好みで選択してみてください。

投稿日時: 19/06/09 17:16:58
投稿者: 園 日暮

ご指導をありがとうございます。
 
早速試しました。
 
ご指導の構文の上と下で試しました。
 1〜12のシートに赤が付きます。
 
 IMEを半角英数してテンキーの数字を1〜12にしても全部に赤が付きます。

回答
投稿日時: 19/06/09 17:31:09
投稿者: mattuwan44

>ご指導の構文の上と下で試しました。
> 1〜12のシートに赤が付きます
 
指導というほどの物でもないですが、
そう書いているからそうなります。
 
そうではなく????

回答
投稿日時: 19/06/09 17:31:57
投稿者: WinArrow
投稿者のウェブサイトに移動

シート名を半角文字に再入力したのですか?
 
全角文字のままでも、StrConvで半角変換できます。
更に、Val関数を使えば、数値チェックも不要になります。
 
↓は例です。

引用:

     If mySheet.Name = Format(Now(), "m") Or mySheet.Name = Format(Now(), "m") Then
          mySheet.Tab.ColorIndex = 3
      End If


     Select Case Val(StrConv(meSheet.Name, vbNarrow))
        Case 1 To 12
          mySheet.Tab.ColorIndex = 3
    End Select

投稿日時: 19/06/09 18:14:11
投稿者: 園 日暮

私の構文に指導を反映した構文
Private Sub Workbook_Open()
  Dim mySheet As Worksheet
  For Each mySheet In Worksheets
      mySheet.Tab.ColorIndex = xlNone
 
   Select Case Val(StrConv(meSheet.Name, vbNarrow))
        Case 1 To 12
          mySheet.Tab.ColorIndex = 3
    End Select
    
      End If
  Next
  End Sub
このような警告が出ます。
コンパイルエラー
1End If に対応するIfブロックがありません。
 
※シート名の変更はテストするために再確認するために行いました。

回答
投稿日時: 19/06/09 18:43:04
投稿者: simple

> End If に対応するIfブロックがありません。
これに対する貴兄の所見は?

投稿日時: 19/06/09 19:02:16
投稿者: 園 日暮

vbaはそんなに詳しくはありません。
所見が言える力は毛頭ありません。
 
こんなエラーは初めての経験です。
すみません

回答
投稿日時: 19/06/09 19:14:37
投稿者: simple

If ...... then

End If 
は、ワンセットで意味を持ちます。
 
あなたのコードには、End Ifだけがあって、
これに対するIf文が無いので、「おかしなコードです」と
Excel君が指摘しているのです。
 
どうしてEnd Ifが出てきたのですか?
書き写した元をもう一度確認して下さい。

回答
投稿日時: 19/06/09 19:17:15
投稿者: simple

ついでに確認ですが、
1月〜12月のシートに同じ色をつけてしまったら、
当月が霞んでしまわないのですか?
当月とマッチしたシートだけに色をつけたほうが目立つ気がしますが、
その辺がちょっと理解できなかったです。

回答
投稿日時: 19/06/09 19:17:50
投稿者: mattuwan44

>End If に対応するIfブロックがありません。
 
End IfとあるのでIfが無いといけないのでは?
 
Ifが無くなったなら、End Ifも無くさないと、文法的におかしいですよね?
 
それより、
 
>下記のVBAの構文でシート名で「1〜12」範囲のみに限り色付けを
>をしたいです。

これの意味は?
 
ぼくは、シート名が
0〜13まであった時、
1〜12までのシート名に色を付けると解釈しましたが???

回答
投稿日時: 19/06/09 19:44:45
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
このような警告が出ます。
コンパイルエラー
1End If に対応するIfブロックがありません。
 

 
私の提案は、
If〜End IF
の3行を
Select〜End Select
の4行に、置き換える
というものです。
ですが、あなたは、なぜか、2行を、4行に置換て
3行目のEnd If だけ残ったままです。
 
忠告
この板で、コード作成してもらうようなことはやめてください。
貰ったコードをひとつ一つ、何をしているのか?どんな意味があるのか?
理解する努力をしてください。
>vbaはそんなに詳しくはありません。
勉強する気のない人には、回答する人がいなくなりますよ。

投稿日時: 19/06/09 19:51:48
投稿者: 園 日暮

そうですか。
 
がんばっていますがごめんなさい。
 
終わりにさせてください。
 
ありがとうございました。