SSブログ

エクセル小僧:交互に色を付ける [コンピューター]

エクセルで、奇数行は灰色、偶数行は塗りつぶし無し、

のようなことをしたいときはどうしたらいいのでしょう?

excel_kougo01.jpg

ネットで検索すると、行番号(ROW)を2で割った余り(MOD)を使って、条件付き書式を作れば
いいことが分かりました。

条件式=MOD(ROW(), 2)=1 [奇数行の場合]
条件式=MOD(ROW(), 2)=0 [偶数行の場合]

エクセルでセルに交互に色を着ける方法(EXCEL2007、2010以降)
http://blog.dacelo.info/windows/entry-1044.html

これをマクロ化しようと思い、上記の条件付き書式の設定作業を、
開発メニュー - マクロの記録で記録したところ、次のようなマクロができました。

Sub Macro1()
  Range("A1:I25").Select
  Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1"
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.249946592608417
  End With
  Selection.FormatConditions(1).StopIfTrue = False
End Sub

出力されたマクロの1行目のセル範囲選択(Range().Select)を削除し、奇数行、偶数行の
いずれかを選択できるように変更したマクロが次のマクロです。

Sub usStripe1()
  '【変数】
  Dim ANS As Integer ' 答え:vbYes(6), vbNo(7)
  Dim mySelRowMod2 As Integer ' 選択されたセル範囲の先頭行の行番号が偶数(0)か、奇数(1)か
  '【実行コード】
  If TypeName(Selection) <> "Range" Then
    MsgBox "セルが選択されていません。" _
    & vbCrLf & "TypeName(Selection)=" & TypeName(Selection), vbExclamation
    Exit Sub
  End If
  ' 条件選択
  ANS = MsgBox("選択範囲(" & Selection.Address & ")のセルを" & vbCrLf _
  & "灰⇒白で塗りつぶし:はい" & vbCrLf & "白⇒灰で塗りつぶし:いいえ", _
  vbYesNoCancel + vbDefaultButton3 + vbExclamation, "どっち?")
  Select Case ANS
  Case vbYes, vbNo
    ' 条件付き書式を削除
    Selection.FormatConditions.Delete
  Case vbCancel
    Exit Sub
  End Select
  ' 選択されたセル範囲の先頭行の行番号が偶数(0)か、奇数(1)か
  mySelRowMod2 = Selection.Range("A1").Row Mod 2
  ' mySelRowMod2=0(偶数行始まり), ANS=6(灰⇒白)=> (0 + 6) Mod 2 = 0 => 偶数行を塗りつぶし
  ' mySelRowMod2=0(偶数行始まり), ANS=7(白⇒灰)=> (0 + 7) Mod 2 = 1 => 奇数行を塗りつぶし
  ' mySelRowMod2=1(奇数行始まり), ANS=6(灰⇒白)=> (1 + 6) Mod 2 = 1 => 奇数行を塗りつぶし
  ' mySelRowMod2=1(奇数行始まり), ANS=7(白⇒灰)=> (1 + 7) Mod 2 = 0 => 偶数行を塗りつぶし
  Select Case ((mySelRowMod2 + ANS) Mod 2)
  Case 0
    ' 条件付き書式の条件:偶数行
    Selection.FormatConditions.Add Type:=xlExpression, _
    Formula1:="=MOD(ROW(),2)=0"
  Case 1
    ' 条件付き書式の条件:奇数行
     Selection.FormatConditions.Add Type:=xlExpression, _
     Formula1:="=MOD(ROW(),2)=1"
  End Select
  ' 塗りつぶし
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.2
  End With
  Selection.FormatConditions(1).StopIfTrue = False
End Sub

※2018/1/19 23:40追記 セル以外のもの、例えば、図形を選択していた場合、TypeName(Selection)がRangeではなくなるため、実行時エラー'438'になります。そこで、TypeName(Selection)がRange以外の場合、マクロを抜ける処理を追加しました。

※2018/1/22 7:05追記 選択したセル範囲が偶数行始まりか、奇数行始まりか、マクロに判断させて、人間には先頭行、3行目、-を塗りつぶすのか、2行目、4行目、-を塗りつぶすのか選択させるようにしてみました。

【参考】
プロパティまたはメソッドが見つかりません
http://officetanaka.net/Excel/vba/error/execution_error/error_423.htm

『選択されている図形の数を数えるには』(x11euser)
http://www.excel.studio-kazu.jp/kw/20101227144026.html

【Excel VBA】Rangeオブジェクトの左上のセルを取得する方法は?
http://q.hatena.ne.jp/1259758448

以上。
ヤバイぜ!(10)  コメント(2) 
共通テーマ:パソコン・インターネット

ヤバイぜ! 10

コメント 2

cheese999

ヤバイぜ! ありがとうございます[__猫]
by cheese999 (2018-01-16 19:39) 

cheese999

セル以外のものを選択していた場合、マクロを抜ける処理を追加しました。
by cheese999 (2018-01-19 23:52) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字(英大文字の「オー」、英小文字の「ユー」、アラビア数字の「ハチ」、アラビア数字の「イチ」、アラビア数字の「ニ」)を入力してください。

Facebook コメント

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。