エクセルのチェックボックスと条件付き書式のコピーについて

Question

エクセル2007を使用しているのですがチェックボックスと、条件付き書式を設定したセルのコピー&ペーストができません。
どのようにすればいいのでしょうか？

B列D列にチェックボックスをおいて、B列の結果をE列に反映させTRUEならH4が青になり、D列の結果をF列に反映させTRUEならH4が赤になり、どちらにもチェックが入っていなければH4はそのままにするというところまでは作れたのですが、行数も５０行ほどあり、反映させるセルも１つづつ違うのですが、コピーと貼り付けで簡単に行を増やしたりすることはできないのでしょうか？また、他にもシートが１５ほどありますので、気が遠くなる作業になりそうです。
添付画像は１つ１つ設定していきました。

設定は下記のようにしました。
チェックボックスのコントロールの書式設定のリンクするセルは「$D4」「$E4」と設定しており、
また、H1は条件付き書式で、ルール「=$E4=TRUE」書式「青の塗りつぶし」適用先「=$H$4」
　　　　　　　　　　　　　ルール「=$D4=TRUE」書式「赤の塗りつぶし」適用先「=$H$4」
としています。
初心者ですので、質問の意味などが分かりにくいかと思いますが回答よろしくお願いします。

Wendy02 · Accepted Answer

>新たな質問になってしまいますが、
簡単です。単に数列を変えればよいだけです。
既存のシートのチェックボックスに新しいマクロを設定するマクロを作りました。（ChengeColorMacroの綴りを直しました)　Sub Main()　と、Private Sub SettingChkBxes(sh As Worksheet)　は、変えていません。

'//
Sub Macro2Form()　'臨時
　'チェックボックスにマクロを設定するためのマクロ
　Call AddMacro(ActiveSheet)
End Sub
Private Sub AddMacro(sh As Worksheet)
　'チェックボックスにマクロを入れる
　Dim obj As Object
　For Each obj In sh.CheckBoxes
　　obj.LinkedCell = ""
　　obj.OnAction = ThisWorkbook.Name & "!ChangeColorMacro"　'改
　　obj.Caption = ""
　Next
End Sub

Private Sub ChangeColorMacro()　'改
　'フォームに取り付けるマクロ
　Dim objChk As Object
　Dim i As Long, j As Long, k As Long, l As Long, nm As String
　Dim x As Long, y As Long
　Dim iColor As Integer
　On Error Resume Next
　nm = Application.Caller
　On Error Resume Next
　With ActiveSheet
　　Set objChk = .CheckBoxes(nm)
　　If Err.Number > 0 Then Exit Sub
　　On Error GoTo 0
　　i = objChk.TopLeftCell.Row
　　j = objChk.TopLeftCell.Column + 2
　　k = objChk.Index - IIf(objChk.Index Mod 2, -1, 1)
　　l = objChk.Index - IIf(objChk.Index Mod 2, 0, 1)
　　If objChk.Value = xlOn Then
　　　.CheckBoxes(k).Value = xlOff
　　Else
　　'.CheckBoxes(k).Value = xlOn 'どちらか一方の場合
　　End If
　　If .CheckBoxes(l).Value = xlOff And .CheckBoxes(l + 1).Value = xlOff Then
　　　iColor = xlColorIndexNone　'両方共Off は、色が消える
　　ElseIf .CheckBoxes(l).Value = xlOn And .CheckBoxes(l + 1).Value = xlOff Then
　　　iColor = 3 '赤
　　ElseIf .CheckBoxes(l).Value = xlOff And .CheckBoxes(l + 1).Value = xlOn Then
　　　iColor = 5 '青
　　End If
　　'位置決め
　　x = Int((i - 4) / 8) * 2 + 4: y = 8 + Int((i - 4) / 2) Mod 4 '改
　　.Cells(x, y).Interior.ColorIndex = iColor
　End With
End Sub

''イメージは分かりましたが、表としてはインパクトが強いです。私には思いもつきません。

keithin · Answer

＞B6,C6のチェックボックスの結果「I4」、B8,C8の結果を「J4」、B10,C10の結果を「K4」
＞B12,C12の結果を「H6」B14,C14の結果を「I6」、B16,C16の結果を「J６」・・・・
＞チェックボックスは、B列、C列に固定させ、結果はHからKまで１行おきに設定させることはできますでしょうか？

前提：
B列の結果がD列に-1/0で出ている
C列の結果がE列に-1/0で出ている

操作：
H4からK20ぐらいのセル範囲をまとめて選んで条件付き書式を開始し

=AND(ROW()>3,MOD(ROW(),2)=0,INDEX($D:$D,INT((ROW()-4))*4+4+(COLUMN()-8)*2)=-1)
でBの色を取り付ける
=AND(ROW()>3,MOD(ROW(),2)=0,INDEX($E:$E,INT((ROW()-4))*4+4+(COLUMN()-8)*2)=-1)
でCの色を取り付ける

＃最初から手抜きせずヤリタイ事をちゃんと説明してくれていれば，こんな何度手間にもならずに済んだ事は分かりますよね？

Wendy02 · Answer

>同じ作業を何百回と繰り返さなければいけなくなりますので、

話が具体的にはっきりとしていれば、一瞬で解決してしまうような内容なのです。分からないので、予め、こちらで、たたき台を最初から決めさせていただきます。違うなら違うとおっしゃっていただければよいです。

・片方がOnが入れば、もう片方はOffで消えるという仕様にしなければならないと、こちらで解釈します。しかし、片方がOff で、もう片方も Off の場合は、両方とも Off とします。ただし、その仕様は、チェックボックスの使い方ではありません。

・位置の違いは、図を以て正しいとさせていただきます。
・色の変化の場所は、H列のみにさせていただきます。

#1さんものは、そのまま現在のコントロールに取り付けるという方式ですが、私のは、まったく新しいブックに試していただくというものに作り替えることにしました。標準モジュールに貼り付けて試してみてください。

Sub Main

を実行してください。現行のマクロは、アクティブシートですから、シート1枚しか設定しないようになっていますが、これで、新規のブックに試してみてください。Main を実行してみてください。本来は、シートに、True/False の出力は必要ないと思いましたので、* の印を付け、不要なら、*の行を削除してください。

シートが何枚でも、大した時間が掛かりません。一括で設定することも可能です。

Sub Main のコードを以下に変えれば、全部のシートにも設定可能です。

Sub Main()
　Dim sh As Worksheet
　Application.ScreenUpdating = False
　For Each sh In ActiveWorkbook.Worksheets
　　If sh.CheckBoxes.Count = 0 Then
　　　Call SettingChkBxes(sh)
　　End If
　Next
　Application.ScreenUpdating = True
End Sub

Wendy02 · Answer

説明は、次の書き込みにします。
'//標準モジュール
Sub Main()
　'ここを実行する
　Application.ScreenUpdating = False
　Call SettingChkBxes(ActiveSheet)
　Application.ScreenUpdating = True
End Sub
Private Sub SettingChkBxes(sh As Worksheet)
　Dim i As Long
　Dim stRow As Long, cnt As Long, cl As Long
　Dim flg As Boolean
　stRow = 4 'スタート行
　cl = 2 '列
　cnt = 50 '個数
　With sh
　　　For i = stRow + 0 To cnt - 1 Step 2　'2行おき
　　　　　.CheckBoxes.Add .Cells(i, cl).Left + 5, .Cells(i, cl).Top + 1, 10, 10
　　　　　.CheckBoxes.Add .Cells(i, cl + 1).Left + 5, .Cells(i, cl + 1).Top + 1, 10, 10
　　　Next
　　　AddMacro sh
　End With
End Sub
Private Sub AddMacro(sh As Worksheet)
　'チェックボックスにマクロを入れる
　Dim obj As Object
　For Each obj In sh.CheckBoxes
　　　obj.LinkedCell = ""
　　　obj.OnAction = ThisWorkbook.Name & "!ChengeColorMacro"
　　　obj.Caption = ""
　Next
End Sub
Private Sub ChengeColorMacro()
　'フォームに取り付けるマクロ
　Dim objChk As Object
　Dim i As Long, j As Long, k As Long, l As Long, nm As String
　Dim iColor As Integer
　On Error Resume Next
　nm = Application.Caller
　On Error Resume Next
　With ActiveSheet
　　　Set objChk = .CheckBoxes(nm)
　　　If Err.Number > 0 Then Exit Sub
　　　On Error GoTo 0
　　　i = objChk.TopLeftCell.Row: j = objChk.TopLeftCell.Column + 2
　　　k = objChk.Index - IIf(objChk.Index Mod 2, -1, 1)
　　　l = objChk.Index - IIf(objChk.Index Mod 2, 0, 1)
　　　If objChk.Value = xlOn Then
　　　　　.CheckBoxes(k).Value = xlOff
　　　Else
　　　'.CheckBoxes(k).Value = xlOn 'どちらか一方の場合
　　　End If
　　　If .CheckBoxes(l).Value = xlOff And .CheckBoxes(l + 1).Value = xlOff Then
　　　　.Cells(i, 4).Value = False '*
　　　　.Cells(i, 5).Value = False '*
　　　　iColor = xlColorIndexNone
　　　ElseIf .CheckBoxes(l).Value = xlOn And .CheckBoxes(l + 1).Value = xlOff Then
　　　　.Cells(i, 4).Value = True '*
　　　　.Cells(i, 5).Value = False '*
　　　　iColor = 3
　　　ElseIf .CheckBoxes(l).Value = xlOff And .CheckBoxes(l + 1).Value = xlOn Then
　　　　.Cells(i, 4).Value = False '*
　　　　.Cells(i, 5).Value = True '*
　　　　iColor = 5
　　　End If
　　　.Cells(i, 8).Interior.ColorIndex = iColor
　　End With
End Sub

Wendy02 · Answer

条件付き書式も、マクロでしてしまえばよいのです。言い換えれば、条件付き書式は要らないということです。

#1さんの回答からすると、質問文と図とも違うようです。一体、どちらが本当なのでしょうか。何か良く分かりません。

文章
B列　--E列
D列　--F列
--
図
B列　--D列
C列　--E列

それと、ルール　E2=-1 　書式　赤に塗りつぶすなら、0 <> TRUE なのだから、正しいようですが、
ただ、ロジックが抜けているようです。

>どちらにもチェックが入っていなければH4はそのままにする
というのは、色を付けないという意味ですね。

もし、そうなら、二者択一ではありませんから、両方共オンの場合もあります。

どちらにもチェックが入っている場合は、どうなるのでしょうか？

また、H列の隣の3つのセル（I,J,K,L)の色つきのセルはなんでしょうか？
どうやら、図では、B列のチェックボタンに反映しているようですが。

それから、今の状態では、色をつける目的だけだったら、まったく、「リンクするセル」は必要ありませんね。

>行数も５０行ほどあり、反映させるセルも１つづつ違うのですが、
>コピーと貼り付けで簡単に行を増やしたりすることはできないのでしょうか？

ひとつのシートを作れば、後は、他のシートへは、コピー＆ペーストで可能です。
もし、その気があれば、こちらの質問にも答えてください。その気がなければ、無視して良いです。別に追いかけはしませんから。

keithin · Answer

ん？

＞横への書式のコピーができません。

「横にコピー」というのは始めて出てきた，後出しのご質問ですね？
でも条件付き書式については，元のご質問に書かれていたやり方で設定の重要な点もきちんと押さえて正しく作成してあったので，大丈夫出来ています後はTRUE/FALSEを-1/0に書き換えるだけで問題なくあなたに出来ます，と判断しました。

なのに
＞ルール　E2=-1 　書式　赤に塗りつぶす　適用先をH3 としたのですが

それでは，元のご相談のご説明では出来ていた「＄の付け具合」を間違っています。
以前出来ていたやり方（ご自分でご相談に「こうやりました」と説明を書いた設定）を再度思い出して，横にコピーしてもＤやＥがずれないよう今度は必要な＄を付けて作成してください。
でも「そうだ＄を付けるんだ！」と飛びついて，何でもかんでも付けたら間違いなので繰り返しますが前に出来ていた通りにやり直しましょう。

keithin · Answer

チェックボックスには「フォーム」と「ActiveXコントロール」の２種類あります。それぞれ使い方も性質も全く違いますので，寄せられた回答も，またあなたご自身のご相談の書きぶりにおいても，一体何を使っているのか必ず明記したり注意してください。

今回この回答では，「フォーム」についてお話しします。

チェックボックス自体は，チェックボックス自体ではなく「チェックボックスが載っているセル」をオートフィルドラッグするなどで，複製することが出来ます。
しかし肝心のご質問の，「リンクするセル」の設定がご希望のように自動で変わっていく方法は，残念ながらありません。

ご相談のような状況では「リンクするセル」の設定を使わず，マクロを併用するような格好で作業する手をご紹介してみます。

手順：
開発タブのマクロのセキュリティで，セキュリティを中にしてエクセルを再起動する
ブックを開く
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub Macro1()
with activesheet.shapes(application.caller).topleftcell.offset(0, 2)
.value = not .value
end with
end sub

ファイルメニューからエクセルに戻る
Ｂ２セル内に，「フォームの」チェックボックスを配置する
「リンクするセル」の設定は入れないで消しておく
チェックボックスを右クリックしてマクロの登録を開始，
さっきコピーしたMacro1があるので選び，ＯＫする。

Ｂ２セルをＣ２にコピーする
Ｂ２：Ｃ２を下向けにえいやっとオートフィルドラッグコピーする

それぞれのチェックボックスをオンオフするとＤＥ列に結果が現れるので，条件付き書式の数式を調整する。

エクセルのチェックボックスと条件付き書式のコピーについて

>新たな質問になってしまいますが、

＞B6,C6のチェックボックスの結果「I4」、B8,C8の結果を「J4」、B10,C10の結果を「K4」

>同じ作業を何百回と繰り返さなければいけなくなりますので、

この回答への補足

説明は、次の書き込みにします。

条件付き書式も、マクロでしてしまえばよいのです。

この回答への補足

ん？

チェックボックスには「フォーム」と「ActiveXコントロール」の２種類あります。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング