Results of 1 - 1 of about 37 for 条件付書式 ３つ以上 (0.008 sec.)
条件付書式 (2650), 3つ以上 (180)
- [[20090605114503]]
- #score: 10901
- @digest: cac3950f9ad8c2727f1c66bda85c10cd
- @id: 43796
- @mdate: 2009-06-06T00:13:08Z
- @size: 13022
- @type: text/plain
- #keywords: myclr (53905), 34363835453915332650 (38744), 346232243 (38744), colr (32741), マツ (22638), myval (14149), 正if (13815), interior (5029), case (4927), colorindex (4137), ト全 (3825), 日: (3120), macro1 (2933), トマ (2742), intersect (2420), xlnone (2395), target (2276), 名: (2169), seiya (2159), ルエ (2156), ァベ (2083), 登録 (1989), ベッ (1856), マク (1847), パイ (1843), ンパ (1820), クロ (1660), イベ (1545), 付書 (1427), change (1301), コー (1289), 記録 (1282)
- 『VBAでセルに色をつけるには?』（マツ）
アルファベットのA〜Oくらいまでをそれぞれ異なる色でセルを色付けをしたいのですが、 条件付き書式では3つまでしか出来ず困っています。 過去ログにも【3つ以上の条件でセルに色をつけるには?】があったので参照していたのですが、 全くの初心者の為応用出来ませんでした。 宜しくお願いします。 ---- 参考になりませんか? [[20050308152110]]『条件付書式の条件は3つが限度?』（よよ） [[20050115131721]]『条件式書式を6つやりたいんですが・・・』（sirouto） 他にも同様の記事は結構あると思います。 リンク先のコードはまさにマツさんが求めてるものだと思います。 一度試してみて、分からないとこがあればお気軽にどうぞ^^ (Dil) ---- 早々の回答ありがとうございます! 早速[[20050115131721]]『条件式書式を6つやりたいんですが・・・』（sirouto）を参照し、 追加してやってみたんですが、【コンパイルエラー End Subが必要です】のBOXが出てきてしまいます。 追加したのが下記なのですが、おかしいでしょうか? 質問ばかりですみません。 ************************************************************************** Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2009/6/5 ユーザー名 : ** Private Sub Worksheet_Change(ByVal Target As Range) '変数宣言 Dim colr As Integer Dim c As Variant If Target.Count > 1 Then Exit Sub If Target.Column <> 1 Then Exit Sub For Each c In Target Select Case c.Value Case "A" colr = 34 ' Case "B" colr = 36 ' Case "C" colr = 38 ' Case "D" colr = 35 ' Case "E" colr = 45 ' Case "F" colr = 39 ' Case "G" colr = 15 ' Case "H" colr = 33 ' Case "I" colr = 26 ' Case "J" colr = 50 ' Case "K" colr = 6 ' Case "L" colr = 3 ' Case "M" colr = 46 ' Case "N" colr = 23 ' Case "O" colr = 22 ' Case "P" colr = 43 ' Case Else colr = xlNone End Select c.Interior.ColorIndex = colr Next c End Sub ' ---- こんな感じにしてくらはい。(ROUGE) Private Sub Worksheet_Change(ByVal Target As Range) Dim colr As Integer Dim c As Range If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub For Each c In Intersect(Target, Range("A:A")) Select Case c.Value Case "A": colr = 34 Case "B": colr = 36 Case "C": colr = 38 Case "D": colr = 35 Case "E": colr = 45 Case "F": colr = 39 Case "G": colr = 15 Case "H": colr = 33 Case "I": colr = 26 Case "J": colr = 50 Case "K": colr = 6 Case "L": colr = 3 Case "M": colr = 46 Case "N": colr = 23 Case "O": colr = 22 Case "P": colr = 43 Case Else: colr = xlNone End Select c.Interior.ColorIndex = colr Next c End Sub ---- こんな感じでも? Private Sub Worksheet_Change(ByVal Target As Range) Dim myVal, myClr, r As Range, x As Long If Intersect(Target, Columns("a")) Is Nothing Then Exit Sub myVal = "ABCDEFGHIJKLMNO" myClr = "34363835453915332650 6 346232243" For Each r In Intersect(Target, Columns("a")) x = InStr(1,myVal, r.Value, 1) '修正 If x = 0 Then r.Interior.ColorIndex = xlNone Else r.Interior.ColorIndex = Val(Mid$(myClr, x * 2 - 1, 2)) End If Next End Sub (seiya) ---- ありがとうございます! 2つともチャレンジしてみたんですけど、また【コンパイルエラー】が出ました。。 根本的なやり方が間違っていますか? 初心者でほんとにすみません。。 **************************************************** Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2009/6/5 ユーザー名 : ** ' Private Sub Worksheet_Change(ByVal Target As Range) Dim colr As Integer Dim c As Range If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub For Each c In Intersect(Target, Range("A:A")) Select Case c.Value Case "A": colr = 34 Case "B": colr = 36 Case "C": colr = 38 Case "D": colr = 35 Case "E": colr = 45 Case "F": colr = 39 Case "G": colr = 15 Case "H": colr = 33 Case "I": colr = 26 Case "J": colr = 50 Case "K": colr = 6 Case "L": colr = 3 Case "M": colr = 46 Case "N": colr = 23 Case "O": colr = 22 Case "P": colr = 43 Case Else: colr = xlNone End Select c.Interior.ColorIndex = colr Next c End Sub ************************************************* Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2009/6/5 ユーザー名 : ** Private Sub Worksheet_Change(ByVal Target As Range) Dim myVal, myClr, r As Range, x As Long If Intersect(Target, Columns("a")) Is Nothing Then Exit Sub myVal = "ABCDEFGHIJKLMNO" myClr = "34363835453915332650 6 346232243" For Each r In Intersect(Target, Columns("a")) x = InStr(1,myVal, r.Value, 1) '修正 If x = 0 Then r.Interior.ColorIndex = xlNone Else r.Interior.ColorIndex = Val(Mid$(myClr, x * 2 - 1, 2)) End If Next End Sub 一番上のSub Macro1()のところが黄色になって止まっています。 （マツ） ---- ''Sub'' Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2009/6/5 ユーザー名 : ** Private ''Sub'' Worksheet_Change(ByVal Target As Range) サブは2つもいりませんよ（dack） ---- 1) 今あるコードを削除する 2) シート見出しを右クリックして [コードの表示] 3) 右空白部分に、提示したコードを変更しないでそのまま貼り付ける。 で、できます。 (seiya) ---- seiyaさんの↓をやってみました。【コード表示】で登録は出来るんですけど、 マクロを押しても登録したものが出てきません。 試しに記録（●のボタンのやつ）をしても登録したものが出てきませんでした。。 ************************************************************* 1) 今あるコードを削除する 2) シート見出しを右クリックして [コードの表示] 3) 右空白部分に、提示したコードを変更しないでそのまま貼り付ける。 ************************************************************* 何かおかしいでしょうか?さっぱり分かりません。。。 （マツ） ---- 提示したコードはチェンジイベントが発生したときに実行されます。 A列の値を変更してみてください。 (seiya) ---- 過去ログや上記で提示されているコードは通常のマクロと違って、イベントマクロというものです。 ある動作を行った時に(今回の場合、該当シートのどこのセルでも、編集した際に) エクセルがそれを感知して自動でコードを実行します。 ご参考にどうぞ。 http://www.asahi-net.or.jp/‾ef2o-inue/vba_k/sub04_130_04.html (Dil) ---- A列の値を変更というのはどうゆうことでしょうか?? 一番初めにやり始めたときはまず●ボタンの記録を一瞬押してマクロを1作って、 編集ボタンを押して[[20050115131721]]『条件式書式を6つやりたいんですが・・・』（sirouto）の分を 貼り付けて【さるをA】に変えて上書きしました。 その時はA列の5行目以降のAと入ったセルは赤く色づけされたので、 続いてクマをB....C...D..という風に変えていったのですが、その際新規のシートで新しく作りました。 その後からコンパイルエラーが出てくるようになって。。 でも一番上にあったSUB〜の分を削除するようにご指摘頂いたのでやっていたのでその通りやっても うまくいかず、次はコード表示からの作業をしてみたら登録したマクロが出てこず、、 知識が無いので一から教えて頂けると助かります。。 ちなみにA〜Pのアルファベットのセルに色づけするのはA列だけでなく、 シート全体にかけたいのですが、、 うまくいかず困っています。。。。。 （マツ） ---- 条件付書式と同じような動作が必要なのですよね? A列の値に変化（数式を使用しないで）が生じた場合を想定しているので そのようなコードになるのです。 下記は自分で実行してください。 Sub test() Dim myVal, myClr, r As Range, x As Long myVal = "ABCDEFGHIJKLMNO" myClr = "34363835453915332650 6 346232243" For Each r In ActiveSheet.UsedRange x = InStr(1,myVal, r.Value, 1) '修正 If x = 0 Then r.Interior.ColorIndex = xlNone Else r.Interior.ColorIndex = Val(Mid$(myClr, x * 2 - 1, 2)) End If Next End Sub (seiya) 追記: 質問はしっかり回答者が理解できるようにしましょう。 ---- seiyaさんの分をコピーしたらマクロボタンにTESTと現れました! ありがとうございます。 ただ、別のシートのA列などに試しにABCDEF...と入力しておいて TESTのマクロを使っても色が変わらないのですが、これは何か変更しないと いけないのでしょうか? （シート全体にマクロがかかるようにはなってますか??） また、先ほどの質問分はややこしくてすみませんでした。。 どの手順が間違っているのか見てもらおうと思ったのですが・・・ （マツ） ---- ActiveSheetが対象なので、選択されているシートにしか実行されません。 これは「条件付書式」とは別物だし... 何をどうしたときに、何をどうしたいのでしょう? > （シート全体にマクロがかかるようにはなってますか??） 意味がわかりません。 (seiya) ---- いつもは手作業を記録させるマクロを使用していました。 （1つのエクセルシートにマクロを登録しておいて、別のエクセルシートを開き そのシート上でマクロを使用するというやり方です。） なので、マクロを記録したシート上では作業することはありませんでした。 複数のエクセルに同じ作業をしなければいけないので・・ 今回も同じようにしたかったのですが、条件付書式が3つまでしか登録出来ないということで 手作業では限界があり、質問させていただきました。 やりたいのはエクセルのシートの全体（A列だけでなく、B列、C列。。）にアルファベットが登録してあるのでセルを色付け をしたいと思いました。 それはシート毎に登録してあるアルファベットの位置が固定では無い為、シート全体に色がつくように マクロを組めたら。。ということです。 手作業なら、まずCtrl+Aでシート全選択をし、条件付書式で【セルの値が⇒次の値に等しい⇒A（パターンで色付け）】 という具合にしているものを全部で15こしたいのです。 無理ならすみません。。 諦めます。。 （マツ） ---- 全てのシートを対象にする ということですか? Sub test() Dim ws As Worksheet, myVal, myClr, r As Range, x As Long myVal = "ABCDEFGHIJKLMNO" myClr = "34363835453915332650 6 346232243" For Each ws In Sheets For Each r In ws.UsedRange x = InStr(1,myVal, r.Value, 1) '修正 If x = 0 Then r.Interior.ColorIndex = xlNone Else r.Interior.ColorIndex = Val(Mid$(myClr, x * 2 - 1, 2)) End If Next Next End Sub (seiya) ---- 基本的な部分で混乱されているようですので、一応もう一度書きます。 通常のマクロですと、ツール→マクロから好きなタイミングで手動で実行できますね? seiyaさんが最後に提示したものはそれですが、それ以外のコードは全てイベントマクロです。 これは上記で書いた通り、何らかの動作(セルの編集等)を行った時に、 エクセルがその都度自動的にマクロを実行するというものです。 >登録したマクロが出てこず このイベントマクロは、ツール→マクロとしても出てきません。 手動で実行する物ではないので。（上の投稿とリンクを見て頂ければ分かるかと思います） Private Sub Worksheet_Change(ByVal Target As Range) ←この記述が Sub ←の代わりだと考えて下さい。 先ほどはこの2つを同時に一箇所に記述してましたので、コンパイルエラーとなります。 コードを記述する箇所も、標準モジュールではなくシートモジュールです。 （今件の場合は） シートタブを右クリック→コードの表示として現れたモジュールがシートモジュールです。 ここに最初のほうのコードを記述する事で、そのシートに対して何らかの編集を行った時に 書き込んだコードが自動で実行されます。 で、seiyaさ〜ん >TESTのマクロを使っても色が変わらないのですが x = InStr(1,r.Value ,myVal , 1) r.Value と myVal は逆ですよね? それと、r.Value が Empty値の時にも色が塗られてしまいます。。 (Dil) ---- > x = InStr(1,r.Value ,myVal , 1) おっと、大変な記載ミスです。すぐ訂正します。 ありがとうございます。 ちなみに、Function/Private Sub procedure はマクロ実行画面に出てきません。 ^^^^^^^ ^^^^^^^^^^^ マツさん すみませんでした、コードを変更しましたので試してください。 (seiya) ---- Dilさん、細かく説明して頂きありがとうございます。 ということは、イベントマクロは作業するシート全てにシートモジュールとして 登録しなければいけないということですね。 それは作業するシートが膨大になるので難しそうです。。 マクロは奥が深いですね。。 seiyaさんもたくさんの回答ありがとうございます! 試してみました! 空白がAと同じ色になって、Pに色がつきませんでした。。 （マツ） ---- Sub test() Dim ws As Worksheet, myVal, myClr, r As Range, x As Long myVal = "ABCDEFGHIJKLMNOP" '<- 変更 myClr = "34363835453915332650 6 346232243" For Each ws In Sheets For Each r In ws.UsedRange x = InStr(1,myVal, r.Value, 1) If (r.Value = "") + (x = 0) Then '修正 r.Interior.ColorIndex = xlNone Else r.Interior.ColorIndex = Val(Mid$(myClr, x * 2 - 1, 2)) End If Next Next End Sub (seiya) ---- お返事遅くなりすみません! 今seiyaさんに直していただいたものを試しました! Pも色がつき、空白はつきませんでした。 これで明日から活用出来ます。 seiyaさん、初心者の私に何度も回答して下さり本当にありがとうございました。! とても助かりました。 （マツ）06/05(金)21:22 ---- マツさん 私のミスで余計な手間がかかってしまって、すみませんでした。 (seiya)... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200906/20090605114503.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608267 words.
訪問者：