Excel (一般機能)

Excelの一般機能に関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2007)
条件付き書式について.
投稿日時: 17/03/18 07:56:14
投稿者: YNo

お教えください。
 
条件付き書式を複数シートへ一括設定したく ctrl+シート名で複数シートを選択するとリボン?の
条件付き書式が灰色になってしまい、出来ないのですが、、
やり方が悪い?、やり方があったらお教えください。
 
または別のシートへ条件付き書式のみをコピーすることは出来ないのでしょうか
 
どうぞよろしくお願いします。

回答
投稿日時: 17/03/18 09:09:24
投稿者: sy

YNo さんの引用:

条件付き書式を複数シートへ一括設定したく ctrl+シート名で複数シートを選択するとリボン?の
条件付き書式が灰色になってしまい、出来ないのですが、、
やり方が悪い?、やり方があったらお教えください。
 
または別のシートへ条件付き書式のみをコピーすることは出来ないのでしょうか

複数シートへの一括設定は2003までは出来ましたが、2007以降は出来なくなっているみたいです。
 
別のシートへ条件付き書式のみコピペはマクロなら可能です。
一般機能では多分出来ないと思います。(出来たらすいません)

回答
投稿日時: 17/03/18 09:32:59
投稿者: んなっと

例えばいくつかのシートのA列に設定したい場合...
 
1.最初のシートだけを選択して、A列に条件付き書式を設定、A列をコピー
2.その他の複数シートを選択(グループ化)してから、同じA列を選択
→貼り付け▼
→形式を選択して貼り付け
→書式
→OK

回答
投稿日時: 17/03/18 11:56:09
投稿者: WinArrow
投稿者のウェブサイトに移動

「形式を選択して貼り付け」の「書式」では、
条件付き書式以外の書式も複写されてしまいます。
 
同一シート内の別のセル範囲に複写するには、
「適用先」に別セル範囲を追加するだけで、複写できますが、
別シートのセル範囲を追加しても適用されません。
 
結局、VBAでも複写先のセル範囲に「条件付き書式」を設定することになります。
 
条件式を複写する場合、
絶対参照、相対参照は、充分なる注意を要します。
詳細は、↓の複写時の注意事項を参照してください。
http://winarrow.web.fc2.com/psoft/fcc/formatcondition3.htm
 

回答
投稿日時: 17/03/18 12:21:31
投稿者: コナミ

ん?参照元は最初のシートだけなんですかね?
私はそれぞれのシートに参照元があるけど各シートで同じことをするのが面倒だと受け取ったのですが。
 
私がやるなら、条件付き書式を設定しているセルをコピー
→複数シートを選択してどこか関係ないセルに貼り付け
→各シートで、貼り付けたセルを選択し条件付き書式の適用範囲を変える
 
結局、各シートでの作業ですが(^-^;

回答
投稿日時: 17/03/18 13:46:55
投稿者: んなっと

「グループ化して一括設定」の質問の場合は、
各シートの構成も同じと考えて回答するようにしています。
YNoさん、まずは「形式を選択して貼り付け(書式)」を試してみてください。
その結果次第で、次の方法を考えましょう。

回答
投稿日時: 17/03/18 13:54:32
投稿者: WinArrow
投稿者のウェブサイトに移動

複数のシートへ一括設定
という希望なので、どのシートも同じセル範囲と推察します。
 
コナミさんと同じ回答になりますが、
 
書式を指定して複数シートには複写できます。
但し、条件付き書式以外の書式も複写されてしまいます。(何度もかきましたが・・・)
 
後で、条件付き書式以外の書式を再設定することで、楽な操作になるかは、内容次第です。
 
もう一つは、これからデータを入力するシートでしたら、
条件付き書式を設定したテンプレートを作成しておき、
シートを追加するとき、テンプレートを指定することもできます。

投稿日時: 17/03/18 14:57:21
投稿者: YNo

ごめんなさい。
 
ちょっと外出している間にたくさんのレス頂いてしまいました、ありがとうございました。
 
sy さん
 
ありがとうございました。
 
>複数シートへの一括設定は2003までは出来ましたが、2007以降は出来なくなっているみたいです。
  
>別のシートへ条件付き書式のみコピペはマクロなら可能です。
 
了解です、マクロはマクロの記録で挑戦後?またおたずねしたいと思いますのでよろしくお願いします。
 
んなっと さん
 
>2.その他の複数シートを選択(グループ化)してから、同じA列を選択
 
複数シートを選択(グループ化)すると貼り付け▼が灰色になってしまいだめだったのですが、
何回かやっているうちに出来てしました、ありがとうございました。
 
WinArrow さん
 
>条件付き書式以外の書式も複写されてしまいます
 
これはOKです。
 
>、、、、、テンプレートを作成しておき、
>シートを追加するとき、テンプレートを指定、、、、、
 
気がついてからは、テンプレート?オリジナルシートを作り条件付き書式を設定後これをコピーするように
したのですが、今回は既入力分のシートをなんとかと思っています。
 
コナミ さん、んなっと さん
 
説明不足でごめんなさい、各シートの構成全く同じです。
 
ありがとうございました、もう少しトライしてみます。

回答
投稿日時: 17/03/18 15:31:13
投稿者: WinArrow
投稿者のウェブサイトに移動

最初の質問時に
>または別のシートへ条件付き書式のみをコピーすることは出来ないのでしょうか
と書いてあったので、
>条件付き書式以外の書式も複写されてしまいます
とコメントしたんですが、
>これはOKです。
ということならば、
  
んなっとさんのレス通りで問題ないものと思います。
 
今回だけの限定処理ならば、VBAを作成して対処するまでもないですね・・

投稿日時: 17/03/18 17:34:09
投稿者: YNo

WinArrow さん
 
ごめんなさい。
>>または別のシートへ条件付き書式のみをコピーすることは出来ないのでしょうか
 
条件付き書式以外の書式考えていませんでした、データはコピーせず条件付き書式の意味でした。
間違っていました。
 
んなっと さんの方法でグループ化して出来る場合と出来ない場合が出てよくわかりません。
一つのシートへは問題なく出来ますのでこれでも書くシートに書き込むことを考えるとずっと楽ですので
これで対応、、、します。
 
VBAでもやってみたいのですが、取りあえずコピーでしのぎます。
 
ありがとうございました。

回答
投稿日時: 17/03/19 08:12:13
投稿者: んなっと

ShiftキーやCtrlキーを併用して複数シートを選択(グループ化)する際、
1.で書いた「最初のシート」は、2.では除かないといけません。
既定ではどのシートが選択されているのかわかりにくいので、注意が必要です。
これもわかりやすく書くべきでした。
重要なことが抜けていました。反省しています。
 
以下はWinArrowさんに対して書きます。
これまでも何度か、私とWinArrowさんの回答スタイルが
大きく違っていると感じたことがありました。
このスレッドをお借りして次のような質問させていただきます。
 
私はわかりやすい文を書くのが得意ではなく、
最初の不完全な回答でさえ何回も推敲しています。
数式の貼り付けに比べて、手順説明は相当時間がかかります。
「条件付き書式以外の書式も貼り付けられてしまう」ことは承知の上で省略しました。
グループ化で処理する際はその他の書式も統一されている可能性が高いので、
面倒な手順説明に比べれば優先度が低く
うまくいかないときに別の方法に切り替えればいいと思うからです。
WinArrowさん、そうは思いませんか?
それとも、重要なことだから最初から必ず質問者に伝えないといけませんか?
自分の回答は常に完璧でなければならないと心がけていらっしゃるのですか?

投稿日時: 17/03/19 08:39:04
投稿者: YNo

んなっと さん
 
ありがとうございます。
>2.では除かないといけません。、、、これはそのようにしていたと思いますが、、、
新しい BOOK でやってみました。問題なく出来ました。データ入力済みのシートに何か問題があるのだと
思います。
 
丁寧な説明本当にありがとうございました。またよろしくお願いします。
 
(前回の書くシート→各シートです、、、他にもおかしな点、、ご判読お願い、、、それとEXCEL Ver2016でした、、2016をクリックした積もりでいたのですが、、ごめんなさい)

回答
投稿日時: 17/03/19 21:06:26
投稿者: WinArrow
投稿者のウェブサイトに移動

>それとも、重要なことだから最初から必ず質問者に伝えないといけませんか?
>自分の回答は常に完璧でなければならないと心がけていらっしゃるのですか?
 
決して、んなっと さんのレスに、ケチをつけたわけでは、ありません。
お気をわるくさせてしまい申し訳ありません。
 
質問者さんの質問の中の
>または別のシートへ条件付き書式のみをコピーすることは出来ないのでしょうか
「条件付き書式のみ」というところを重要視したからです。
 
後で、データを除くということが説明されましたが、
この部分は重要だと質問者さんに伝えたかったです。

投稿日時: 17/03/20 08:18:10
投稿者: YNo

WinArrow さん
 
ごめんなさい、私の書き方がまずかったために、、、、、
「条件付き書式のコピー」、、、とすればよかったのですね。他の?書式まで気が回らず
「条件付き書式のみ」と書いてしまいました。ご迷惑おかけしました。

回答
投稿日時: 17/03/20 09:08:28
投稿者: んなっと

以下のページも参考になるかもしれません。
  
条件付き書式をコピーして他のセルに貼り付ける
適用対象: Excel 2016, Excel 2013
https://support.office.com/ja-jp/article/%E6%9D%A1%E4%BB%B6%E4%BB%98%E3%81%8D%E6%9B%B8%E5%BC%8F%E3%82%92%E3%82%B3%E3%83%94%E3%83%BC%E3%81%97%E3%81%A6%E4%BB%96%E3%81%AE%E3%82%BB%E3%83%AB%E3%81%AB%E8%B2%BC%E3%82%8A%E4%BB%98%E3%81%91%E3%82%8B-306efe99-f1d5-4a1f-851b-c9695ab05001
   
位置の異なるセル範囲に貼り付けるときは、上記ページの 
注: も大切なことです(条件が数式の場合)。
しかし今回のようにグループ化して貼り付けるときは、
位置は完全に同じなのであまり関係がありません。
それほど「重要」ではないので、無視してください。
  
期待したものと異なる回答は無視する質問者も多いのに、
YNoさんはすべての回答にコメントを返していますね。立派です。

回答
投稿日時: 17/03/20 09:40:50
投稿者: sy

んなっと さんの引用:
うまくいかないときに別の方法に切り替えればいいと思うからです。
WinArrowさん、そうは思いませんか?
それとも、重要なことだから最初から必ず質問者に伝えないといけませんか?
自分の回答は常に完璧でなければならないと心がけていらっしゃるのですか?

ちょっとこれを見たら少し言いたくなりました。
まぁ見なかったら別にどうでも良い事だったんですけど。
 
その前にこの文面はWinArrowさんがんなっとさんの回答にケチをつけられたと思われたから書かれたんでしょうか?
 
私はWinArrowさんは単なるYNoさんの質問に対する皆さんの回答の補足を解説しただけと捉えましたが、んなっとさんはケチをつけられたと捉えられたんですね?
 
自分の回答にケチをつけると言う意味なら、今回の要件では初めのYNoさんの文面では
条件付き書式のみのコピペ(セルの書式は除く)
作業グループの状態で条件付き書式の設定を行う
と言う内容の文面でした。
 
であるならば私の回答が正解だと思いますが?
 
以降のんなっとさんの回答は良案ではありますけど、あくまで代替え案でしかないですし、ですがまるで私の回答が間違ってると言わんばかりの進行の仕方になってるとは思いませんか?
WinArrowさんのフォローが無ければ、そう捉えても不思議じゃないですよね。
 
ケチをつけると言う観点から発言されているのなら、ご自身の回答も私の回答にケチをつけていますよ。
それに検索でこのスレをみた人が条件付き書式だけのコピペ(セルの書式を除く)が出来ると間違えます。
実害があるかどうかは別にして、んなっとさんの回答が正解では無いのは事実です。
 
そう言う観点で考えられているのなら、「代替え案です」の一言があっても良いと思います。
それともこんな短い一言を入れるのがそんなに大変なんですか?
 
人間ですから誰でも間違う事はあるでしょうし、完璧な答えのみ回答するのは難しいと思います。
ですが質問に対して出来る出来ないの回答や、正解なのか代替え案なのかの前置きは、分かっているのならきちんとするべきと思います。
私も文章作るのは苦手でこの文面なんか1時間以上考えて書きましたが、また回答1つにしてもマクロや数式なんか大抵は5分から30分かからないくらいで作れるけど、回答文を考えるのに30分から1時間とか考えて回答するので回答数が人より遥かに少ないですが、少なくとも私は常にそう心掛けていますし実際にしなかった事は無いと思います。
と言うかそんな前置きなんて、正確な回答をしてる人に対しての最低限のマナーでしょう。
書くのが当然の事と思いますが。
私の言う事は間違ってますか?

回答
投稿日時: 17/03/20 11:11:25
投稿者: んなっと

syさん、申し訳ありませんでした。
今回のsyさんの回答はまったく気に留めていません。
私の最初の書き込みは、「YNoさんの質問に対しての回答」に過ぎません。
そして2番目以降は「WinArrowさんの書き込み」に対して書いています。
信じてください。

回答
投稿日時: 17/03/20 11:20:55
投稿者: んなっと

あ、最後の方の17/03/20 09:08:28の私の書き込みは、
YNoさんに対して書いた参考情報と感想です。

回答
投稿日時: 17/03/20 11:25:07
投稿者: WinArrow
投稿者のウェブサイトに移動

syさん、フォローありがとうございます。
 
>自分の回答は常に完璧でなければならないと心がけていらっしゃるのですか?
 
私は、こんなこと考えたことありません。
また、回答の正確さは、回答者が決めるのではなく、
質問者が判断するものと考えています。
 
私は、質問者の意図をできるだけくみ取って(想像や推察)、
その中で、自分の経験、または、自分が試してみて(勉強して)
質問者に(少しおこがましいが)少しでもお役に立てていただければ・・・
という思いで対応しています。(自分が勉強になることの方が多いです。)
私も、文章を書くのが苦手な部類に入ります。
その時の状況で、言葉足らずになることもあります。その時はごめんなさい。
 
質問者の意図をくみ取る・・・といっても、質問者の説明文だけが頼りです。
文章だけのコミュニケーション、って難しいですね・・
 
以上、私の感想というか心境です。
 
 
 
 
 

回答
投稿日時: 17/03/20 11:30:51
投稿者: んなっと

WinArrowさん、私の方こそ感情的になってしまい、申し訳ありませんでした。

回答
投稿日時: 17/03/20 12:11:31
投稿者: んなっと

引用:
回答の正確さは、回答者が決めるのではなく、
質問者が判断するものと考えています。

今後気を付けます。

投稿日時: 17/03/20 15:40:38
投稿者: YNo

んなっと さん
>以下のページも参考になるかもしれません。
>条件付き書式をコピーして他のセルに貼り付ける、、、
 
これも、複数シートでも問題なく出来ました。
ありがとうございました。
 
また、回答をお寄せくださった皆様ありがとうございました。
質問の文言が悪くご迷惑をおかけしました。お詫びいたします。
これに懲りずにまたよろしくお願いします。

回答
投稿日時: 17/03/20 17:12:32
投稿者: んなっと

引用:
条件付き書式を複数シートへ一括設定したく ctrl+シート名で複数シートを選択するとリボン?の
条件付き書式が灰色になってしまい、出来ないのですが、、
やり方が悪い?、やり方があったらお教えください。
  
または...

この「または」があるのですから、質問文は全く問題ないですよ。
「または」以前の部分を独立させれば、最低限必要な情報は伝わっています。
質問の最大のポイントは
「複数シートへ一括設定したく ctrl+シート名..」
の部分ですよね?
 
繰り返しになりますが、むしろYNoさんは質問者の鑑です。

回答
投稿日時: 17/03/20 17:51:03
投稿者: sy

YNoさん
 
YNoさんには全く問題ありません。
 
今回の事は全員少しでも良い回答をしようとの思いが食い違って衝突しただけに過ぎないと思っています。
皆さん少しでも質問者さんの為になろうとの意識が本当に高いので、こう言う事もたまにはあると思ってスルーしてやって下さい。
 
スレをお借りして議論したので気にさせてしまい、大変申し訳ありませんでした。
此方こそこれに懲りずにまた質問して下さい。

回答
投稿日時: 17/03/20 18:15:24
投稿者: WinArrow
投稿者のウェブサイトに移動

YNoさんへ
>質問の文言が悪く
 
私も、決して、文言は悪いとは思っていません。
むしろ、模範ともいえる文章と思いますよ。
 
最初は、んなっとさんと同じレスをしようと少し悩んでいました。
 
文章が簡潔なだけに、「条件付き書式のみをコピー」は、
「形式を選択して貼り付け」−「書式」は試されたものと
勝手に思いこんでしまいました。
 
結果論ですが、YNoさんが、意図したことと文章が少し違ったと分かりまし。
まあ、よくあることです。
 
 
 
 
 

回答
投稿日時: 17/03/21 13:27:10
投稿者: んなっと

解決前の状況も、解決に至った結果もどちらも最初に思った通りでホッとしました。
最初の質問文を正しく読めば、何がポイントなのかわかると思うのですが...
 
まだ閉じられていないので、ポイントから少しだけ離れて書き込みます。
YNoさんの、

引用:
マクロはマクロの記録で挑戦後

という書き込みはsyさんの書き込みに対するレスですが、
もしも挑戦するおつもりでしたら、WinArrowさんの次の書き込みをヒントにするといいと思います。
引用:
結局、VBAでも複写先のセル範囲に「条件付き書式」を設定することになります。

WinArrowさんのサイトを拝見しました。情報が充実していますね。勉強になります。

投稿日時: 17/03/21 15:53:17
投稿者: YNo

んなっと さま
ありがとうございます。私もちょっとほっとしました。
 
セル範囲b5からj20の範囲でb列がブランクでなければb列からJ列に罫線を
引くことでマクロの記録をしてみましたら以下のようになりました、、、、
 
Sub Macro罫線()
'
' A列がブランクでなければ罫線を引く
    ActiveSheet.Select '追加
 
    Range("B5:J20").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=($B5)<>"""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub
罫線を引くだけでこんなになっちゃうんですね。
VBAはここではないですし、ヘルプで確認したいとは思いますが私には理解は
無理みたいです。
 
 
皆様ありがとうございました。
今後ともよろしくお願いします。

回答
投稿日時: 17/03/21 16:18:15
投稿者: WinArrow
投稿者のウェブサイトに移動

>罫線を引くだけでこんなになっちゃうんですね。
 
マクロの記録では、コードが冗長的に作成されます。
メンテナンスを考慮した場合、冗長部分をかなり集約する必要があります。
 

マクロの記録で「罫線を引く」をコード化すると
左、上、右、下・・と4方向のコードが作成されますが、
4方向を一括(1行)のコードがあります。
 
セル.Borders.LineStyle = True
 
これだけで、罫線が引けます。
 
この例は、極端ですが、
このように冗長部分を集約するとスッキリさせることができます。
 
何処が冗長部分なのかを判断するには、勉強と訓練が必要ですが・・・

投稿日時: 17/03/21 19:17:52
投稿者: YNo

WinArrow さま
 
ありがとうございます。
引っ張ってしまいすみません。
下記でいいのでしょうか?
 
Sub Macro罫線3()
'
' A列がブランクでなければ罫線を引く
 
    ActiveSheet.Select
    Range("B5:J20").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=($B5)<>"""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 'なくても動く?
    Selection.FormatConditions(1).Borders.LineStyle = True
    Selection.FormatConditions(1).StopIfTrue = False
     
End Sub
 
よろしくお願いします。
 

回答
投稿日時: 17/03/21 20:24:23
投稿者: WinArrow
投稿者のウェブサイトに移動

幾つかの留意点
 
(1)ActiveSheet.Select の行
 このメソッドは、シートをアクティブにする命令です。
 (.Selectでも.Activeでも同じ)
 しかし、ActiveSheetは、既にアクテイブになっているシートなので、
 アクティブにする必要はない。
 それよりも、条件付き書式設定をするシートを特定した方がよいです。
 
(2)条件付き書式を.ADDすると、設定個数が1つ増えます。
> Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
> Selection.FormatConditions(1).Borders.LineStyle = True
> Selection.FormatConditions(1).StopIfTrue = False
の1行目は、最後の条件付き書式を指定していますが、2行目、3行目は、「1」を指定しています。
条件付き書式が1つの場合は、問題ないが、複数設定する場合だと、2〜3行目も.Countを使うことになります。
また、SetFirstPriority も設定が1つの場合は、無くてもよいが、複数設定する場合は、あった方がよいです。
 
(3)セル範囲の選択解除にういて
条件付き書式を設定する場合、セル範囲を選択する方が面倒ではない方法ですが、選択しなくてもできます。
(この件は省略します)
が、処理の最後には、マナーとしてセルの選択を解除しましょう。
 
 
一挙に複数シートの同一領域に、複数の条件付き書式を設定するコードを例示します。
1つ目:罫線設定、2つ目:文字色設定(B列セルの値が100を超える場合)
Sub 複数シートの同一セル範囲に2つの条件付き書式を設定するサンプル()
Dim Sht As Worksheet, i As Long
 
For Each Sht In ThisWorkbook.Worksheets
    With Sht
        .Select
        With .Range("B5:J20")
            .Select
            .FormatConditions.Add _
                Type:=xlExpression, _
                Formula1:="=($B5)<>"""""
            i = .FormatConditions.Count
            With .FormatConditions(i)
                .SetFirstPriority 'なくても動く?
                .Borders.LineStyle = True
                .StopIfTrue = False
            End With
            .FormatConditions.Add _
                Type:=xlExpression, _
                Formula1:="=($B5)>100"
            i = .FormatConditions.Count
            With .FormatConditions(i)
                .Font.Color = vbRed
                .StopIfTrue = False
            End With
        End With
        Application.CutCopyMode = False
    End With
Next
ThisWorkbook.Sheets(1).Activate
End Sub
 
 

回答
投稿日時: 17/03/21 22:12:31
投稿者: sy

ちょっと???な部分が。
絶対の自信がある分けじゃないですけど、以下じゃないですかね?

WinArrow さんの引用:

(2)条件付き書式を.ADDすると、設定個数が1つ増えます。
> Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
> Selection.FormatConditions(1).Borders.LineStyle = True
> Selection.FormatConditions(1).StopIfTrue = False
の1行目は、最後の条件付き書式を指定していますが、2行目、3行目は、「1」を指定しています。
条件付き書式が1つの場合は、問題ないが、複数設定する場合だと、2〜3行目も.Countを使うことになります。
また、SetFirstPriority も設定が1つの場合は、無くてもよいが、複数設定する場合は、あった方がよいです。

まず2・3行目を(1)にする場合、SetFirstPriority は必須です。
SetFirstPriority を記述するとセットした条件を一番上(1番目)にします。
なので2・3行目は(1)で良いと言う事になります。
 
逆に2・3行目を適切な順位、もしくは.FormatConditions.Count で統一するなら必須では無いと思います。
 
以下の.SetFirstPriority をそのまま実行と、コメントアウトして実行して、条件のセット順の違いを見比べてみて下さい。
Sub 一つ目シートに条件付き書式を設定()
 
    With Sheets(1).Range("B5:J20")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$B5<>"""""
        With .FormatConditions(.FormatConditions.Count)
            .Borders.LineStyle = True
            .StopIfTrue = False
        End With
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$B5>100"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority '←これをコメントアウトして結果を比べて下さい。
            .Font.Color = vbRed
            .StopIfTrue = False
        End With
    End With

End Sub

 
WinArrow さんの引用:

(3)セル範囲の選択解除について
処理の最後には、マナーとしてセルの選択を解除しましょう。
       Application.CutCopyMode = False

Application.CutCopyMode = False はコピーモードを解除するけどセル選択は解除しませんよ。
と言うか選択は解除できませんよね?(Selectの事を言ってるんですよね?違うのかな?)
アクティブか非アクティブには出来ても、最低でも1つ以上のセルはシートが非アクティブ状態でも常に選択されています。
非アクティブの時はSelectで指定出来ないと言うだけでアクティブになった時に選択されてるセルが実際には裏で選択されている筈です。
 
 
 
後条件付き書式のコピペに関して、WinArrowさんやんなっとさんの言われるように、厳密には設定する事になります。
これについては正確な発言で無かったですね、申し訳ありません。
正確には各プロパティに既存のシートの条件を指定できると言う事です。
VBAでよく使う .Value=.Value と同じ考えですね。(左辺の値に、右辺の値をセット)
以下のような記述になります。
内容を説明すると混乱しそうなので、もう少しVBAを勉強されてからの方が良いと思います。
プロパティは罫線(上下左右一括)とフォントカラーだけにしています。
Sub 他シートに一つ目シートの条件付き書式を設定()
    Const shName As String = "Sheet1" '条件付き書式の設定してあるシート名
    Const rngName As String = "B5:J20" '条件付き書式の設定してあるセル範囲
    Dim sh As Worksheet, i As Long
    Dim rng As Range
    Dim var1(3) As Variant
    Dim var2(3) As Variant

    Set rng = Sheets(shName).Range(rngName)
    With rng.FormatConditions(1)
        var1(0) = .Formula1
        var1(1) = .Borders.LineStyle
        var1(2) = .Font.Color
        var1(3) = .StopIfTrue
    End With
    With rng.FormatConditions(2)
        var2(0) = .Formula1
        var2(1) = .Borders.LineStyle
        var2(2) = .Font.Color
        var2(3) = .StopIfTrue
    End With

    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> Sheets(shName).Name Then
            With sh.Range(rngName)
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:=var1(0)
                With .FormatConditions(1)
                    If Not IsNull(var1(1)) Then .Borders.LineStyle = var1(1)
                    If Not IsNull(var1(2)) Then .Font.Color = var1(2)
                    .StopIfTrue = var1(3)
                End With
                .FormatConditions.Add Type:=xlExpression, Formula1:=var2(0)
                With .FormatConditions(2)
                    If Not IsNull(var2(1)) Then .Borders.LineStyle = var2(1)
                    If Not IsNull(var2(2)) Then .Font.Color = var2(2)
                    .StopIfTrue = var2(3)
                End With
            End With
        End If
    Next sh
    ThisWorkbook.Sheets(1).Activate

End Sub

回答
投稿日時: 17/03/21 22:44:21
投稿者: WinArrow
投稿者のウェブサイトに移動

sy さんの引用:

まず2・3行目を(1)にする場合、SetFirstPriority は必須です。
SetFirstPriority を記述するとセットした条件を一番上(1番目)にします。
なので2・3行目は(1)で良いと言う事になります。

>SetFirstPriority は必須です。
SetFirstPriorityが不要だといっているのではなく、
あるセル範囲に対しての条件付き書式設定が、1つならば、優先度をつける必要が無いということです。
 
私の例示では、1つ目の「条件付き書式設定」では、SetFirstPriorityを設定し、
2つ目の「条件付き書式設定」では、SetFirstPriorityを付けていません。
 
 
sy さんの引用:

Application.CutCopyMode = False はコピーモードを解除するけどセル選択は解除しませんよ。
と言うか選択は解除できませんよね?(Selectの事を言ってるんですよね?違うのかな?)

コピーモードを解除する・・その通りです。
一寸、混乱して書き込んでしまいました。

回答
投稿日時: 17/03/21 22:53:15
投稿者: WinArrow
投稿者のウェブサイトに移動

[quote winarrow]
私の例示では、1つ目の「条件付き書式設定」では、SetFirstPriorityを設定し、
 2つ目の「条件付き書式設定」では、SetFirstPriorityを付けていません。
[/quote]
これって、あまり自慢できることではなかったです。
1つ目も2つ目も
.StopIfTrue = False
になっていますから、
2つの条件が合えば、両方の書式が適用されるからです。
 
1つ目の設定が
.StopIfTrue = True
だったら、2つ目は検査されないから、SetFirstPriority が活きてくるけど・・・

投稿日時: 17/03/22 11:36:21
投稿者: YNo

ありがとうございます。
WinArrow さんの
>一挙に複数シートの同一領域に、複数の条件付き書式を設定するコードを、、、も
 
 sy さんの
>他シートに一つ目シートの条件付き書式を設定、、、どちらもできました。
 
すみませんが、、、お二方のコードでコピー先を限定?するにはどうすればいいのでしょうか?
For Each sh In ThisWorkbook.Worksheets これは全シート?
コピー先はシート名頭が2桁の数字のシート(11〜???、12〜???)等、、のみにしたいのですが、、、
 
恐れ入りますがよろしくお願いします。

回答
投稿日時: 17/03/22 13:24:51
投稿者: んなっと

syさんのコードをお借りします。
 
        If sh.Name <> Sheets(shName).Name Then  
に追加条件を入れて
        If sh.Name <> Sheets(shName).Name And sh.Name Like "##*" Then
でしょうか。
 
条件や書式が変わるたびにコードの手直しが必要ですが、VBAの勉強には役に立つと思います。
コードの手直しを減らす、手抜きの方法を最後の方に書かせてください。
 
マクロの話もある程度進んだところで、ここまでの流れを整理します。
[1]質問文の「または」の前の部分に対して

引用:
条件付き書式を複数シートへ一括設定したく ctrl+シート名で複数シートを選択するとリボン?の
条件付き書式が灰色になってしまい、出来ないのですが、、
やり方が悪い?、やり方があったらお教えください。

一般機能の「形式を選択して貼り付け→書式」が最適かつ唯一に近い方法です。
マクロを使うにしても、結局は書式の貼り付けと同じようなことをするか、
後述の[2]のような複雑な手順が必要になります。
「ctrl+シート名で複数シートを選択」するのですから、
絶対参照・相対参照・参照元の情報は、今回はあまり関係がありません。
その他の書式についても、全く同じ可能性が高く、気にする必要なないと考えるのが自然です。
 
さて、現在問題になっている...
[2]質問文の「または」と、その後の部分に対して
引用:
または別のシートへ条件付き書式のみをコピーすることは出来ないのでしょうか

一般機能では無理。
条件や書式の種類を限定しないのであれば、マクロでも現実には不可能に近いような気がします。
現在は、
 
 1.最初のシートで条件付き書式設定のマクロ記録してから
 2.コードを手直し
 3.最後にその他のシートをループするコードまたは呼び出し元のモジュールを追加
 
という方向で話が進んでいるところですね。今は3.です。
 
さてここで、3.の後に複数シートをグループ化して適用したい状況だと仮定します。
今回のYNoさんの状況をお借りします。
その場合のみ、2.の手直しを極力少なくして
1.のコードをほとんどそのまま使う方法もあるかもしれません。
以下、その手抜きの方法です。
 
 1.・1つ目のシートで、どこか関係ないセルを選択した状態にしておく
  ・マクロ記録を開始
  ・最初に対象のセル範囲(例えばA列全体)を選択する操作から始める
  ・次に条件付き書式を設定する操作をして
  ・記録終了
(記録例)
 
Sub Macro1()
    Columns("A:A").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
        Formula1:="=$B$1", Formula2:="=10"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub
 
 2.条件に数式を使っている部分だけチェックし、あとはそのまま
(例)
  Formula1:="=$B$1" のような形はOK
  .ColorScaleCriteria(1).Value = "=Sheet1!$G$2" のような形だけ、Sheet1!を削除するかどうか考える
 
 3.記録されたMacro1などの上に、コードを追加して以下のように
 
Sub GroupSheetsMacro()
  Dim SSh
  Dim Sh As Worksheet
  Set SSh = ActiveWindow.SelectedSheets
  For Each Sh In SSh
    Sh.Select
    Call Macro1 '記録されたマクロ名に変更
  Next
End Sub

Sub Macro1()
    Columns("A:A").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
        Formula1:="=$B$1", Formula2:="=10"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub
 
 4.その他のシートをShiftキーやCtrlキーを使って複数選択(グループ化)
 →GroupSheetsMacro実行
 
VBAの鉄則「不要なSelectはするな」などには反していますが、
記録マクロが変わってもほんの少しの手直しで済みます。
ただしうまくいかないこともある上に、邪道ですので、
「これはこれで面倒だ」と思ったら無視してください。

回答
投稿日時: 17/03/22 14:02:12
投稿者: WinArrow
投稿者のウェブサイトに移動

[quote YNo]すみませんが、、、お二方のコードでコピー先を限定?するにはどうすればいいのでしょうか?
For Each sh In ThisWorkbook.Worksheets これは全シート?
コピー先はシート名頭が2桁の数字のシート(11〜???、12〜???)等、、のみにしたいのですが、、、
 [/quote]
 
私のコードは、条件付き書式を複写するコードではありません。
理由は、複写でも、新規設定でも、殆ど同じことをしないといけないので
全てのシートに同じ条件付き設定を新規設定するコードになっています。
 
syさんのコードは、
1番目のシートに条件付き書式を設定しておいて、他のシートに複写しているコードになっていますが、
条件付き書式のみをそっくり複写はできない(条件付き書式以外が複写されないように)ので
複写先シートに、.Add メソッドで器だけ作成し、その中に数式、書式を複写しています。
 
※比較していただければわかりますが、新規設定でも、複写でもほとんど同じことをすることになります。

回答
投稿日時: 17/03/22 14:34:49
投稿者: WinArrow
投稿者のウェブサイトに移動

条件付き書式を含む書尾式を他シートの同じセル範囲に一挙に複写するコードサンプルです。
 
1番目のシートの指定領域に条件付き書式が設定されている条件となっています。
 
Sub 条件付き書式を含む書式を複写するサンプル()
Dim shts, s As Long, TargetCell As String
 
    TargetCell = "A1:J20"
With ThisWorkbook
    ReDim shts(1 To .Sheets.Count - 1)
    For s = 2 To .Sheets.Count
        shts(s - 1) = .Sheets(s).Name
        .Sheets(s).Range(TargetCell).FormatConditions.Delete
    Next
    .Sheets(1).Range(TargetCell).Copy
    .Sheets(shts).Select
    .Sheets(shts(1)).Activate
    Range(TargetCell).Select
    Selection.PasteSpecial Paste:=xlPasteFormats
    .Sheets(1).Select
    Application.CutCopyMode = False
End With
End Sub
 
 

投稿日時: 17/03/22 15:07:38
投稿者: YNo

んなっと さん
ありがとうございます。
> If sh.Name <> Sheets(shName).Name And sh.Name Like "##*" Then、、出来ました。##が数字に
相当するんですね。
 
条件付き書式のコピーについて、、、
>一般機能の「形式を選択して貼り付け→書式」が最適かつ唯一に近い方法です。
了解です。コピーの方法をお教えいただきましたのでこれで出来ますし、前にも書きましたが
、気がついてからはオリジナルのシートを作りこれをコピーして使うようにしています。
ありがとうございました。
 
WinArrow さん
ありがとうございます。
ごめんなさい、また表現がまずかったですね。コピー先、、、条件付き書式を設定するシート、、、、
でしょうか?すみませんでした。
 
>条件付き書式を含む書尾式を他シートの同じセル範囲に一挙に複写するコードサンプルです。
ありがとうございます。
トライしてみます時間をください。
 
 
 
 

回答
投稿日時: 17/03/22 21:49:34
投稿者: んなっと

修正します。
 
条件や書式が変わるたびにコードの手直しが必要ですが、

条件や書式が変わるとコードの手直しが必要になることがありますが、

投稿日時: 17/03/23 06:56:43
投稿者: YNo

WinArrow さん
>条件付き書式を含む書尾式を他シートの同じセル範囲に一挙に複写するコードサンプルです。
ありがとうございます。出来ました。
 
んなっと さん
>条件や書式が変わるとコードの手直しが必要になることがありますが、
「これはこれで面倒だ」と思ったら無視してください。←このレスのところですね。了解です。
面倒、、とんでもない、、ではないのですが理解不足で、、、ただ call する方法でしたら条件付き書式を
別々に少しずつ?作っていいのですね。
 
ありがとうございました。

回答
投稿日時: 17/03/23 18:17:43
投稿者: んなっと

余計な書き込みを続けてごめんなさい。
[2]がほとんど不可能に近い理由を示します。
下の長いコードでも不完全なんです。もちろん私の力不足もありますが。
 
 今回は、あらかじめ条件付き書式が設定してある最初のシートが表示された状態で
→その他のシートタブをShiftキーやCtrlキーも使って追加選択(グループ化)
→FCMultiSheet実行
 
Sub FCMultiSheet()
  Dim j As Long
  Dim Op As Long
  Dim r As Range
  Dim SSh
  Dim S As Worksheet, Sh As Worksheet
  Dim F
  Dim FC 'As FormatCondition
  Dim CS As ColorScale
  Dim Db As Databar
  Dim Tp As Top10
  Dim Ic As IconSetCondition
  Dim UV As UniqueValues
  Dim AA As AboveAverage
  Dim Bd
  Set S = ActiveSheet
  Set SSh = ActiveWindow.SelectedSheets
  Bd = Array(xlLeft, xlRight, xlTop, xlBottom)
  For Each Sh In SSh
    If Sh.Name <> S.Name Then
      Sh.Cells.FormatConditions.Delete
      For Each F In S.Cells.FormatConditions
        Set r = Sh.Range(F.AppliesTo.Address)
        Op = 0
        On Error Resume Next
        Op = F.Operator
        On Error GoTo 0
        Select Case F.Type
          Case xlCellValue, xlExpression
            Select Case Op
              Case xlBetween, xlNotBetween
                Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1, F.Formula2)
              Case Else
                Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1)
            End Select
          Case xlColorScale
            Set CS = r.FormatConditions.AddColorScale(F.ColorScaleCriteria.Count)
            For j = 1 To F.ColorScaleCriteria.Count
              With CS
                .ColorScaleCriteria(j).FormatColor.Color = F.ColorScaleCriteria(j).FormatColor.Color
                .ColorScaleCriteria(j).Type = F.ColorScaleCriteria(j).Type
                On Error Resume Next
                .ColorScaleCriteria(j).Value = F.ColorScaleCriteria(j).Value
                On Error GoTo 0
              End With
            Next j
            Set FC = CS
          Case xlDatabar
            Set Db = r.FormatConditions.AddDatabar
            With Db
              .ShowValue = F.ShowValue
              .MinPoint.Modify F.MinPoint.Type, F.MinPoint.Value
              .MaxPoint.Modify F.MaxPoint.Type, F.MaxPoint.Value
              With .BarColor
                .Color = F.BarColor.Color
                .TintAndShade = F.BarColor.TintAndShade
              End With
              .BarFillType = F.BarFillType
              .Direction = F.Direction
              .NegativeBarFormat.ColorType = F.NegativeBarFormat.ColorType
              .BarBorder.Type = F.BarBorder.Type
              .AxisPosition = F.AxisPosition
              With .AxisColor
                .Color = F.AxisColor.Color
                .TintAndShade = F.AxisColor.TintAndShade
              End With
              With .NegativeBarFormat.Color
                .Color = F.NegativeBarFormat.Color.Color
                .TintAndShade = F.NegativeBarFormat.Color.TintAndShade
              End With
            End With
            Set FC = Db
          Case xlTop10
            Set Tp = r.FormatConditions.AddTop10
            With Tp
              .TopBottom = F.TopBottom
              .Rank = F.Rank
              .Percent = F.Percent
            End With
            Set FC = Tp
          Case 6 'XlIconSet
            Set Ic = r.FormatConditions.AddIconSetCondition
            With Ic.IconCriteria
              For j = 1 To .Count
                With .Item(j)
                  .Icon = F.IconCriteria(j).Icon
                  On Error Resume Next
                  .Type = F.IconCriteria(j).Type
                  .Value = F.IconCriteria(j).Value
                  On Error GoTo 0
                End With
              Next j
            End With
            Set FC = Ic
          Case xlUniqueValues
            Set UV = r.FormatConditions.AddUniqueValues
            UV.DupeUnique = F.DupeUnique
            Set FC = UV
          Case xlTextString
            Set FC = r.FormatConditions.Add(F.Type, , , , F.Text, F.TextOperator)
          Case xlTimePeriod
            Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1, , , , F.DateOperator)
          Case xlAboveAverageCondition
            Set AA = r.FormatConditions.AddAboveAverage
            AA.AboveBelow = F.AboveBelow
            Set FC = AA
          Case Else
            Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1)
        End Select
        With FC
          On Error Resume Next
          With .Interior
            .Pattern = F.Interior.Pattern
            .ColorIndex = F.Interior.ColorIndex
            .PatternColorIndex = F.Interior.PatternColorIndex
          End With
          For j = 0 To 3
            With .Borders(Bd(j))
              .LineStyle = F.Borders.LineStyle
              .ColorIndex = F.Borders.ColorIndex
              .TintAndShade = F.Borders.TintAndShade
            End With
          Next j
          With .Font
            .Bold = F.Font.Bold
            .ColorIndex = F.Font.ColorIndex
            .Italic = F.Font.Italic
            .Name = F.Font.Name
            .Size = F.Font.Size
            .Underline = F.Font.Underline
          End With
          If Len(F.NumberFormat) > 0 Then
            .NumberFormat = F.NumberFormat
          End If
          .StopIfTrue = F.StopIfTrue
          On Error GoTo 0
        End With
      Next
    End If
  Next
End Sub

回答
投稿日時: 17/03/24 07:31:39
投稿者: sy

んなっと さんの引用:
[2]がほとんど不可能

これには私も同意です。
訂正していますが
条件付き書式の各プロパティに既存のセルのプロパティをセットする事は出来るけど予め全てのプロパティを羅列しないとカバーできないので、限定的にプロパティを決め打ちにすれば可能です。
と言う事を書いただけのつもりでした。
 
ただコードは以下のような感じで良いと思いますよ。
NumberFormat だけなぜか設定できないんですが、、、
https://msdn.microsoft.com/ja-jp/library/office/ff820867.aspx
此処では値の取得と設定が可能って書いてあるのに、、、
Sub 他シートに一つ目シートの条件付き書式を設定2()
    Const shName As String = "Sheet1" '条件付き書式の設定してあるシート名
    Const rngName As String = "B5:J20" '条件付き書式の設定してあるセル範囲
    Dim sh As Worksheet
    Dim rng As Range
    Dim var1 As Variant
    Dim i As Integer
    Dim k As Integer

    Set rng = Sheets(shName).Range(rngName)
    ReDim var1(1 To rng.FormatConditions.Count)
    For i = 1 To rng.FormatConditions.Count
        var1(i) = Array(, , , , , , , , 0)
        With rng.FormatConditions(i)
            var1(i)(0) = .AppliesTo.Address
            var1(i)(1) = .Formula1
            var1(i)(2) = .Borders.LineStyle
            var1(i)(3) = (.Font.ColorIndex <> xlAutomatic)
            var1(i)(4) = .Font.Color
            var1(i)(5) = .Interior.ColorIndex
            var1(i)(6) = .Interior.Color
            var1(i)(7) = .NumberFormat
            var1(i)(8) = .StopIfTrue
        End With
    Next i

    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> Sheets(shName).Name And sh.Name Like "##*" Then
            sh.Range(rngName).FormatConditions.Delete
            For i = 1 To UBound(var1)
                With sh.Range(var1(i)(0))
                    For k = 1 To Sheets(shName).Range(var1(i)(0)).FormatConditions.Count
                        .FormatConditions.Add Type:=xlExpression, Formula1:=var1(i)(1)
                        With .FormatConditions(k)
                            If Not IsNull(var1(i)(2)) Then .Borders.LineStyle = var1(i)(2)
                            If var1(i)(3) Then .Font.Color = var1(i)(4)
                            If var1(i)(5) Then .Interior.Color = var1(i)(6)
                            .StopIfTrue = var1(i)(8)
                            If Not IsEmpty(var1(i)(7)) Then .NumberFormat = "" & var1(i)(7) & ""
                        End With
                    Next k
                End With
            Next i
        End If
    Next sh

End Sub

回答
投稿日時: 17/03/24 10:22:02
投稿者: んなっと

なるほど、syさんありがとうございます。
xlAutomaticかどうかの判断を追加すればいいんですね。
修正します。
 
Sub FCMultiSheet()
  Dim j As Long
  Dim Op As Long
  Dim r As Range
  Dim SSh
  Dim S As Worksheet, sh As Worksheet
  Dim F
  Dim FC 'As FormatCondition
  Dim CS As ColorScale
  Dim Db As Databar
  Dim Tp As Top10
  Dim Ic As IconSetCondition
  Dim UV As UniqueValues
  Dim AA As AboveAverage
  Dim Bd
  Set S = ActiveSheet
  Set SSh = ActiveWindow.SelectedSheets
  Bd = Array(xlLeft, xlRight, xlTop, xlBottom)
  For Each sh In SSh
    If sh.Name <> S.Name Then
      sh.Cells.FormatConditions.Delete
      For Each F In S.Cells.FormatConditions
        Set r = sh.Range(F.AppliesTo.Address)
        Op = 0
        On Error Resume Next
        Op = F.Operator
        On Error GoTo 0
        Select Case F.Type
          Case xlCellValue, xlExpression
            Select Case Op
              Case xlBetween, xlNotBetween
                Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1, F.Formula2)
              Case Else
                Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1)
            End Select
          Case xlColorScale
            Set CS = r.FormatConditions.AddColorScale(F.ColorScaleCriteria.Count)
            For j = 1 To F.ColorScaleCriteria.Count
              With CS
                .ColorScaleCriteria(j).FormatColor.Color = F.ColorScaleCriteria(j).FormatColor.Color
                .ColorScaleCriteria(j).Type = F.ColorScaleCriteria(j).Type
                On Error Resume Next
                .ColorScaleCriteria(j).Value = F.ColorScaleCriteria(j).Value
                On Error GoTo 0
              End With
            Next j
            Set FC = CS
          Case xlDatabar
            Set Db = r.FormatConditions.AddDatabar
            With Db
              .ShowValue = F.ShowValue
              .MinPoint.Modify F.MinPoint.Type, F.MinPoint.Value
              .MaxPoint.Modify F.MaxPoint.Type, F.MaxPoint.Value
              With .BarColor
                .Color = F.BarColor.Color
                .TintAndShade = F.BarColor.TintAndShade
              End With
              .BarFillType = F.BarFillType
              .Direction = F.Direction
              .NegativeBarFormat.ColorType = F.NegativeBarFormat.ColorType
              .BarBorder.Type = F.BarBorder.Type
              .AxisPosition = F.AxisPosition
              With .AxisColor
                .Color = F.AxisColor.Color
                .TintAndShade = F.AxisColor.TintAndShade
              End With
              With .NegativeBarFormat.Color
                .Color = F.NegativeBarFormat.Color.Color
                .TintAndShade = F.NegativeBarFormat.Color.TintAndShade
              End With
            End With
            Set FC = Db
          Case xlTop10
            Set Tp = r.FormatConditions.AddTop10
            With Tp
              .TopBottom = F.TopBottom
              .Rank = F.Rank
              .Percent = F.Percent
            End With
            Set FC = Tp
          Case 6 'XlIconSet
            Set Ic = r.FormatConditions.AddIconSetCondition
            With Ic.IconCriteria
              For j = 1 To .Count
                With .Item(j)
                  .Icon = F.IconCriteria(j).Icon
                  On Error Resume Next
                  .Type = F.IconCriteria(j).Type
                  .Value = F.IconCriteria(j).Value
                  On Error GoTo 0
                End With
              Next j
            End With
            Set FC = Ic
          Case xlUniqueValues
            Set UV = r.FormatConditions.AddUniqueValues
            UV.DupeUnique = F.DupeUnique
            Set FC = UV
          Case xlTextString
            Set FC = r.FormatConditions.Add(F.Type, , , , F.Text, F.TextOperator)
          Case xlTimePeriod
            Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1, , , , F.DateOperator)
          Case xlAboveAverageCondition
            Set AA = r.FormatConditions.AddAboveAverage
            AA.AboveBelow = F.AboveBelow
            Set FC = AA
          Case Else
            Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1)
        End Select
        With FC
          On Error Resume Next
          With .Interior
            .Pattern = F.Interior.Pattern
            If F.Interior.ColorIndex <> xlAutomatic Then
              .Color = F.Interior.Color
            End If
            If F.Interior.PatternColorIndex <> xlAutomatic Then
              .PatternColor = F.Interior.PatternColor
            End If
          End With
          For j = 0 To 3
            With .Borders(Bd(j))
              .LineStyle = F.Borders(Bd(j)).LineStyle
              If F.Borders(Bd(j)).ColorIndex <> xlAutomatic Then
                .Color = F.Borders(Bd(j)).Color
              End If
              .TintAndShade = F.Borders(Bd(j)).TintAndShade
            End With
          Next j
          With .Font
            .Bold = F.Font.Bold
            If F.Font.ColorIndex <> xlAutomatic Then
              .Color = F.Font.Color
            End If
            .Italic = F.Font.Italic
            .Name = F.Font.Name
            .Size = F.Font.Size
            .Underline = F.Font.Underline
          End With
          If Len(F.NumberFormat) > 0 Then
            .NumberFormat = F.NumberFormat
          End If
          .StopIfTrue = F.StopIfTrue
          On Error GoTo 0
        End With
      Next
    End If
  Next
End Sub
   
使い物にならないですね...
YNoさん、今回の私の書き込みも無駄な書き込みです。

投稿日時: 17/03/24 10:27:30
投稿者: YNo

んなっと さん
ありがとうございます。
すごいですね!出来ました。ちょっとずつ設定の違った条件付き書式もいっぺんに統一出来てしまいます。
[2]、、、難しくてわかりません。
ありがとうございました。
 
sy さん
ありがとうございます。
難しくなってしまいよくわかりません。
>他シートに一つ目シートの条件付き書式を設定2() 、、はこれからトライします。
 
ありがとうございました。

投稿日時: 17/03/24 10:32:29
投稿者: YNo

んなっと さん
ごめんなさい、10:22のを見ずに送信してしまいました。

回答
投稿日時: 17/03/24 12:24:24
投稿者: んなっと

とにかくきりがないんです。
例えばフォントや罫線の部分を削除・追加...
 
Sub FCMultiSheet()
  Dim j As Long
  Dim Op As Long
  Dim r As Range
  Dim SSh
  Dim S As Worksheet, sh As Worksheet
  Dim F
  Dim FC 'As FormatCondition
  Dim CS As ColorScale
  Dim Db As Databar
  Dim Tp As Top10
  Dim Ic As IconSetCondition
  Dim UV As UniqueValues
  Dim AA As AboveAverage
  Dim Bd
  Set S = ActiveSheet
  Set SSh = ActiveWindow.SelectedSheets
  Bd = Array(xlLeft, xlRight, xlTop, xlBottom)
  For Each sh In SSh
    If sh.Name <> S.Name Then
      sh.Cells.FormatConditions.Delete
      For Each F In S.Cells.FormatConditions
        Set r = sh.Range(F.AppliesTo.Address)
        Op = 0
        On Error Resume Next
        Op = F.Operator
        On Error GoTo 0
        Select Case F.Type
          Case xlCellValue, xlExpression
            Select Case Op
              Case xlBetween, xlNotBetween
                Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1, F.Formula2)
              Case Else
                Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1)
            End Select
          Case xlColorScale
            Set CS = r.FormatConditions.AddColorScale(F.ColorScaleCriteria.Count)
            For j = 1 To F.ColorScaleCriteria.Count
              With CS
                .ColorScaleCriteria(j).FormatColor.Color = F.ColorScaleCriteria(j).FormatColor.Color
                .ColorScaleCriteria(j).Type = F.ColorScaleCriteria(j).Type
                On Error Resume Next
                .ColorScaleCriteria(j).Value = F.ColorScaleCriteria(j).Value
                On Error GoTo 0
              End With
            Next j
            Set FC = CS
          Case xlDatabar
            Set Db = r.FormatConditions.AddDatabar
            With Db
              .ShowValue = F.ShowValue
              .MinPoint.Modify F.MinPoint.Type, F.MinPoint.Value
              .MaxPoint.Modify F.MaxPoint.Type, F.MaxPoint.Value
              With .BarColor
                .Color = F.BarColor.Color
                .TintAndShade = F.BarColor.TintAndShade
              End With
              .BarFillType = F.BarFillType
              .Direction = F.Direction
              .NegativeBarFormat.ColorType = F.NegativeBarFormat.ColorType
              .BarBorder.Type = F.BarBorder.Type
              .AxisPosition = F.AxisPosition
              With .AxisColor
                .Color = F.AxisColor.Color
                .TintAndShade = F.AxisColor.TintAndShade
              End With
              With .NegativeBarFormat.Color
                .Color = F.NegativeBarFormat.Color.Color
                .TintAndShade = F.NegativeBarFormat.Color.TintAndShade
              End With
            End With
            Set FC = Db
          Case xlTop10
            Set Tp = r.FormatConditions.AddTop10
            With Tp
              .TopBottom = F.TopBottom
              .Rank = F.Rank
              .Percent = F.Percent
            End With
            Set FC = Tp
          Case 6 'XlIconSet
            Set Ic = r.FormatConditions.AddIconSetCondition
            With Ic.IconCriteria
              For j = 1 To .Count
                With .Item(j)
                  .Icon = F.IconCriteria(j).Icon
                  On Error Resume Next
                  .Type = F.IconCriteria(j).Type
                  .Value = F.IconCriteria(j).Value
                  On Error GoTo 0
                End With
              Next j
            End With
            Set FC = Ic
          Case xlUniqueValues
            Set UV = r.FormatConditions.AddUniqueValues
            UV.DupeUnique = F.DupeUnique
            Set FC = UV
          Case xlTextString
            Set FC = r.FormatConditions.Add(F.Type, , , , F.Text, F.TextOperator)
          Case xlTimePeriod
            Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1, , , , F.DateOperator)
          Case xlAboveAverageCondition
            Set AA = r.FormatConditions.AddAboveAverage
            AA.AboveBelow = F.AboveBelow
            Set FC = AA
          Case Else
            Set FC = r.FormatConditions.Add(F.Type, Op, F.Formula1)
        End Select
        With FC
          On Error Resume Next
          With .Interior
            .Pattern = F.Interior.Pattern
            If F.Interior.ColorIndex <> xlAutomatic Then
              .Color = F.Interior.Color
            End If
            If F.Interior.PatternColorIndex <> xlAutomatic Then
              .PatternColor = F.Interior.PatternColor
            End If
            .TintAndShade = F.Interior.TintAndShade
            .PatternTintAndShade = F.Interior.PatternTintAndShade
          End With
          For j = 0 To 3
            With .Borders(Bd(j))
              .LineStyle = F.Borders(Bd(j)).LineStyle
              If F.Borders(Bd(j)).LineStyle <> xlNone Then
                .Color = F.Borders(Bd(j)).Color
                .TintAndShade = F.Borders(Bd(j)).TintAndShade
                .Weight = F.Borders(Bd(j)).Weight
              End If
            End With
          Next j
          With .Font
            .Bold = F.Font.Bold
            If F.Font.ColorIndex <> xlAutomatic Then
              .Color = F.Font.Color
            End If
            .Italic = F.Font.Italic
            .Bold = F.Font.Italic
            .Underline = F.Font.Underline
            .TintAndShade = F.Font.TintAndShade
          End With
          If Len(F.NumberFormat) > 0 Then
            .NumberFormat = F.NumberFormat
          End If
          .StopIfTrue = F.StopIfTrue
          On Error GoTo 0
        End With
      Next
    End If
  Next
End Sub
 
     
まだまだ削除・追加しないといけない部分があります。
私の結論:いくら頑張っても現在のExcelのバージョンでは[2]は不可能で、[1]は書式貼り付けが唯一の正解

回答
投稿日時: 17/03/24 23:32:49
投稿者: WinArrow
投稿者のウェブサイトに移動

んなっと さんの引用:

Excelのバージョンでは[2]は不可能

御意!!
条件付き書式の全パターンを盛り込もうとすると、きが遠くなります。
ユーザーフォームを利用して、
ルールの選択
書式の選択(複数あってもよいでしょう)
という方法で切り分けすれば、ある程度は、汎用化できると思います。
 
 
余談ですが、
Excel95には、セルのプロパティの表示機能がサポートされていました。
それをヒントに、Excel2007バージョンで、「見CELL」というアドインを作成しました。
アクティブセルを対象に「セルの書式設定」ダイアログの全項目+参照先/参照元(他シートも)+条件付き書式+入力規則+シート情報+ブック情報・・・盛りたくさんの情報を表示するもでのですが、
条件付き書式のExcel2007から追加されたルールのところで、ギブアップ状態。
こんなことにチャレンジすると、スゴ〜ク勉強になりますね。

投稿日時: 17/03/25 10:47:14
投稿者: YNo

sy さま
連遅れ申し訳ありません。
>Sub 他シートに一つ目シートの条件付き書式を設定2()  17/03/24 07:31:39
やっと出来ました。 自分でお尋ねしておきながら、、sh.Name Like "##*" Then に気づかず
苦闘していました。
ただ条件付書式の摘用先をたとえば =$b$5:$j$20,$l$5:$l$20のように[,]で区切って書いてあると
NG?のようでコピー先のシートで式が設定されていないと出てしまいます。
[,]で区切って書くこと自体がNG?本来だめ?今まで気つかず使っていました。分けたら問題なく出来ました。
 
ありがとうございました。
 
んなっと さま
 
とにかくきりがないんです。
>一般機能の「形式を選択して貼り付け→書式」が最適かつ唯一に近い方法です。
了解です。
 
ありがとうございました。
 
WinArrow さま
ありがとうございます。
 
 
 
 

回答
投稿日時: 17/03/25 14:04:10
投稿者: sy

YNo さんの引用:
ただ条件付書式の摘用先をたとえば =$b$5:$j$20,$l$5:$l$20のように[,]で区切って書いてあると
NG?のようでコピー先のシートで式が設定されていないと出てしまいます。
[,]で区切って書くこと自体がNG?本来だめ?今まで気つかず使っていました。分けたら問題なく出来ました。

余り引っ張る事では無いんですけど、変なコードを提示したままはちょっと恥ずかしいので、これを最後にしますけど再アップします。
>For k = 1 To Sheets(shName).Range(var1(i)(0)).FormatConditions.Count
これが余計でFormatConditions.Countの数に矛盾が出来てしまっていたのでエラーになってました。
forを外してaddの所を(k)では無く(.FormatConditions.Count)にしなければいけませんでした。
NumberFormat が設定できなかったのもそれが原因でした。
 
以下修正版です。
対応書式は修正前と同じ罫線(一括セット)・フォント色・背景色・表示書式のみです。
全ての書式に対応させるような事はんなっとさんも言われるように、きりが無いので出来ません。
Sub 他シートに一つ目シートの条件付き書式を設定2()
    Const shName As String = "Sheet1" '条件付き書式の設定してあるシート名
    Const rngName As String = "B5:J20" '条件付き書式の設定してあるセル範囲
    Dim sh As Worksheet
    Dim rng As Range
    Dim var1 As Variant
    Dim i As Integer
    Dim k As Integer

    Set rng = Sheets(shName).Range(rngName)
    ReDim var1(1 To rng.FormatConditions.Count)
    For i = 1 To rng.FormatConditions.Count
        var1(i) = Array(, , , , , , , , 0)
        With rng.FormatConditions(i)
            var1(i)(0) = .AppliesTo.Address
            var1(i)(1) = .Formula1
            var1(i)(2) = .Borders.LineStyle
            var1(i)(3) = (.Font.ColorIndex <> xlAutomatic)
            var1(i)(4) = .Font.Color
            var1(i)(5) = .Interior.ColorIndex
            var1(i)(6) = .Interior.Color
            var1(i)(7) = .NumberFormat
            var1(i)(8) = .StopIfTrue
        End With
    Next i

    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> Sheets(shName).Name And sh.Name Like "##*" Then
            sh.Range(rngName).FormatConditions.Delete
            For i = 1 To UBound(var1)
                With sh.Range(var1(i)(0))
                    .FormatConditions.Add Type:=xlExpression, Formula1:=var1(i)(1)
                    With .FormatConditions(.FormatConditions.Count)
                        If Not IsNull(var1(i)(2)) Then .Borders.LineStyle = var1(i)(2)
                        If var1(i)(3) Then .Font.Color = var1(i)(4)
                        If var1(i)(5) Then .Interior.Color = var1(i)(6)
                        .StopIfTrue = var1(i)(8)
                        If Not IsEmpty(var1(i)(7)) Then .NumberFormat = "" & var1(i)(7) & ""
                    End With
                End With
            Next i
        End If
    Next sh

End Sub

投稿日時: 17/03/25 14:35:45
投稿者: YNo

sy さま
早速ありがとうございます。
ばっちりです。説明していただいてもよくわかりません。お許しください。
 
ありがとうございました。

トピックに返信