Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11847 / 13646 ツリー ←次へ | 前へ→

【13710】こんな条件に従ってセルの色を塗りつぶしたいのですが・・・ くりりん 04/5/11(火) 16:05 質問[未読]
【13711】Re:こんな条件に従ってセルの色を塗りつぶ... ちゃっぴ 04/5/11(火) 16:38 回答[未読]
【13726】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 10:09 質問[未読]
【13729】Re:こんな条件に従ってセルの色を塗りつぶ... ちゃっぴ 04/5/12(水) 10:48 回答[未読]
【13731】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 11:16 質問[未読]
【13733】Re:こんな条件に従ってセルの色を塗りつぶ... [名前なし] 04/5/12(水) 11:26 回答[未読]
【13735】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 11:56 質問[未読]
【13736】Re:こんな条件に従ってセルの色を塗りつぶ... ちゃっぴ 04/5/12(水) 12:19 回答[未読]
【13739】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 13:15 質問[未読]
【13740】Re:こんな条件に従ってセルの色を塗りつぶ... ちゃっぴ 04/5/12(水) 13:34 回答[未読]
【13741】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 13:55 お礼[未読]
【13743】Re:こんな条件に従ってセルの色を塗りつぶ... ちゃっぴ 04/5/12(水) 14:08 回答[未読]
【13745】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 15:20 質問[未読]
【13746】Re:こんな条件に従ってセルの色を塗りつぶ... ちゃっぴ 04/5/12(水) 16:17 回答[未読]
【13747】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 16:28 お礼[未読]
【13713】Re:こんな条件に従ってセルの色を塗りつぶ... Jaka 04/5/11(火) 16:41 回答[未読]
【13728】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 10:21 質問[未読]
【13773】Re:こんな条件に従ってセルの色を塗りつぶ... Jaka 04/5/13(木) 9:52 回答[未読]
【13789】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/13(木) 15:43 お礼[未読]
【13730】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 10:53 質問[未読]
【13732】Re:こんな条件に従ってセルの色を塗りつぶ... ちゃっぴ 04/5/12(水) 11:20 回答[未読]
【13742】Re:こんな条件に従ってセルの色を塗りつぶ... くりりん 04/5/12(水) 14:03 お礼[未読]

【13710】こんな条件に従ってセルの色を塗りつぶし...
質問  くりりん  - 04/5/11(火) 16:05 -

引用なし
パスワード
   はじめまして、どなたか教えて下さいm(__)m

A列のセルには項目名、B列〜Z列のセルには数値を入力するようになっているとします。
B列〜Z列のセルに数値を入力したとき、同じ行のA列の項目名によって
数値を入力したセルの色を塗りつぶすようにするにはどうしたらよいでしょうか?
条件付書式を利用しようと思ったのですが、項目名が5つあるので条件が足りず
利用出来ません。
項目名は5つですが、あらかじめA列に項目が入っているわけではなく、数値を
入力するときに項目名も入力します。
雰囲気的には、B列〜Z列のセルをそれぞれ見て、数字が入力されていたら、
同じ行のA列のセルを見て、"項目名ア"だったら、数字入力のセルを赤色に、"項目名イ"だったら青色に、という風に処理したいのです。
For Each...Nextを使えばよいのかなぁと思いチャレンジしてみましたが、
うまくいきません(>_<)
よろしくお願いしますm(__)m

【13711】Re:こんな条件に従ってセルの色を塗りつ...
回答  ちゃっぴ E-MAIL  - 04/5/11(火) 16:38 -

引用なし
パスワード
   こんな感じですか?

Sub PaintColor()
  Dim rngTarget As Range
  Dim lngColorIndex As Long
  
  For Each rngTarget In セル範囲 'セル範囲にはデータベース全体を指定
    With rngTarget
      If .Column = 1 Then   'A列の場合
        Select Case .Value
          '項目名ごとにカラーインデックスを指定
          Case Is = "項目名A"
            lngColorIndex = 色1
          Case Is = "項目名B"
            lngColorIndex = 色2
          '・・・・以下略
        End Select
      Else          '以外
        'セルに値が入力されている場合塗りつぶし
        If .vlaue <> "" Then
          .Interior.ColorIndex = lngColorIndex
        End If
      End If
    End With
  Next rngTarget
End Sub

ちなみに、エラーを防止するためにも項目名フィールドには
入力規則を設けておくほうがよいかと思います。

【13713】Re:こんな条件に従ってセルの色を塗りつ...
回答  Jaka  - 04/5/11(火) 16:41 -

引用なし
パスワード
   Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  If Target.Column >= 2 And Target.Column <= 26 Then
    If Target.Value <> "" Then
     Select Case Cells(Target.Row, 1).Value
       Case "ア"
         Target.Interior.ColorIndex = 5
       Case "イ"
         Target.Interior.ColorIndex = 3
       Case "他"
        
     End Select
    Else
      Target.Interior.ColorIndex = 0
    End If
  End If
End Sub

【13726】Re:こんな条件に従ってセルの色を塗りつ...
質問  くりりん  - 04/5/12(水) 10:09 -

引用なし
パスワード
   ▼ちゃっぴ さん、早々の回答ありがとうございます(^o^)
昨日会社からの質問でしたが、そんなにすぐ回答は頂けないと思い
質問したまま帰ってしまったので、お礼が遅くなりすみませんでしたm(__)m

さて、早速試してみたのですが、

>        If .vlaue <> "" Then

↑ここでエラー(実行時エラー438 オブジェクトは、このプロパティ
またはメゾットをサポートしていません。)が出てしまいました。

たぶん、セル範囲をちゃっぴ さんがおっしゃったようにデータベース全体ではなく、
Range("x3:id230")としてしまったせいだと思います。

元々私の質問の仕方がいけなかったです。実際はp列に項目名があり、a〜o列、
q〜w列は数値ではない文字列が入力してありセルの色を変えたくないのです。また
230行以下には他の表があり、そちらもセルの色をかえたくないのです・・・

2度手間を取らせて申し訳ありませんが、再度教えて下さい。

【13728】Re:こんな条件に従ってセルの色を塗りつ...
質問  くりりん  - 04/5/12(水) 10:21 -

引用なし
パスワード
   ▼Jaka さん、早々の回答ありがとうございます(^o^)
 昨日会社からの質問でしたが、そんなにすぐ回答は頂けないと思い
 質問したまま帰ってしまったので、お礼が遅くなりすみませんでしたm(__)m:

で、早速試そうと思ったのですが・・・
大変初歩的な質問で申し訳ありませんが、こういうタイプのマクロは
どういう風に動かすのでしょうか?
いつも、Sub マクロ名() で始まるものしかやったことがなく、
動かすときはメニューバーのマクロから、マクロ名を指定して実行しています。
Jakaさんの回答をコピーして自分で変更すべきところは変えてVBAを閉じたのですが
マクロ名が登録されないため、動かし方が分からないのです。
セルに数値を入れれば自動にマクロが実行されるのかな?と思いやってみましたが
そうでもなさそうですし。
ヘルプでWorksheet_Changeを調べようと思いましたが、出てきませんし。

申し訳ありません、教えて下さいm(__)m

【13729】Re:こんな条件に従ってセルの色を塗りつ...
回答  ちゃっぴ E-MAIL  - 04/5/12(水) 10:48 -

引用なし
パスワード
   すみませんタイプミスしました。(o*。_。)oペコッ

>>        If .vlaue <> "" Then
            ↓
           valueが正しいです。

p列に項目名がある場合というのであれば

If .Column = 1 Then   'A列の場合
        ↓ 
If .Column = 16 Then   'P列の場合(16はP列を示します)

X列以降に変換データがある場合

Else          '以外
       ↓
ElseIf .Column > 23  'W列以降の場合(23はW列を示します)

上記のように変更すれば動作すると思います。

ただ、この方法ではデータ変更の都度、マクロを手動実行しなければならない為、
データ変更時自動実行させるには、Jakaさんのようにイベントプロシジャーを
用いるのがよいかと思います。

【13730】Re:こんな条件に従ってセルの色を塗りつ...
質問  くりりん  - 04/5/12(水) 10:53 -

引用なし
パスワード
   あれから、自分なりに色々やっていみたら一応出来ました。
以下がそれなんですが、知識が少なすぎてどうも邪道っぽい
ような気がします(-_-;)
変なところをご指摘して頂けないでしょうか?

実際はp列に項目名、x〜id列の3〜230行目のセルに数値が入ります。

Sub セルの色()

Dim i2, i3 As Integer
  For i3 = 3 To 230
  For i2 = 24 To 238
    
    If Cells(i3, i2).Value > 0 Then
    
      Select Case Cells(i3, 16)

        Case "A"
           Cells(i3, i2).Interior.ColorIndex = 5
           
         Case "B"
           Cells(i3, i2).Interior.ColorIndex = 10
  
         Case "C"
           Cells(i3, i2).Interior.ColorIndex = 35
  
         Case "D"
           Cells(i3, i2).Interior.ColorIndex = 36
           
         Case "E"
            Cells(i3, i2).Interior.ColorIndex = 38
            

      End Select
     
    Else

      Cells(i3, i2).Interior.ColorIndex = 0

    End If

  Next i2
  
  Next i3
End Sub

【13731】Re:こんな条件に従ってセルの色を塗りつ...
質問  くりりん  - 04/5/12(水) 11:16 -

引用なし
パスワード
   ちゃっぴさん、度々すみません。
>>>        If .vlaue <> "" Then
>            ↓
>           valueが正しいです。
>
>p列に項目名がある場合というのであれば
>
>If .Column = 1 Then   'A列の場合
>        ↓ 
>If .Column = 16 Then   'P列の場合(16はP列を示します)

ここまで変えてやってみました。マクロは最後まで実行出来ましたが、
セルの色が変わりません。(今まで色が塗りつぶされていたセルも全て
塗りつぶし無しになってしまいました)


あと、
>Else          '以外
>       ↓
>ElseIf .Column > 23  'W列以降の場合(23はW列を示します)
>
上記のように変更したら、エラーメッセージ『コンパイルエラー 修正候補:Then』
が出てしまいました(T_T)

【13732】Re:こんな条件に従ってセルの色を塗りつ...
回答  ちゃっぴ E-MAIL  - 04/5/12(水) 11:20 -

引用なし
パスワード
   速度を求めないのであれば、作成されたものでかまわないと思います。

速度を重視するのであれば、
1. セル範囲をループする場合For Each 〜 Next文を使用
2. 処理を行わないセル範囲はループから除外
3. 同じオブジェクト参照は出来るだけ変数を使用するかWith文を使用する。

以上の点を踏まえ、修正すればよいかと思います。

【13733】Re:こんな条件に従ってセルの色を塗りつ...
回答  [名前なし] E-MAIL  - 04/5/12(水) 11:26 -

引用なし
パスワード
   >>Else          '以外
>>       ↓
>>ElseIf .Column > 23  'W列以降の場合(23はW列を示します)
>>
>上記のように変更したら、エラーメッセージ『コンパイルエラー 修正候補:Then』
>が出てしまいました(T_T)

すみません"Then"が抜けてました・・・追加してください。

>ここまで変えてやってみました。マクロは最後まで実行出来ましたが、
>セルの色が変わりません。(今まで色が塗りつぶされていたセルも全て
>塗りつぶし無しになってしまいました)

Case文の中で色番号に「0(白)」もしくは「xlNone」をして指定ませんか?

【13735】Re:こんな条件に従ってセルの色を塗りつ...
質問  くりりん  - 04/5/12(水) 11:56 -

引用なし
パスワード
   色番号に「0(白)」もしくは「xlNone」は指定してないのですが・・・
作った構文は以下の通りです。

Sub PaintColor()
   Dim rngTarget As Range
   Dim lngColorIndex As Long
  
   For Each rngTarget In Range("x3:id230") 
     With rngTarget
       If .Column = 16 Then  
         Select Case .Value
           '項目名ごとにカラーインデックスを指定
           Case Is = "A"
             lngColorIndex = 5
           Case Is = "B"
             lngColorIndex = 10
           Case Is = "C"
             lngColorIndex = 35
           Case Is = "D"
             lngColorIndex = 36
           Case Is = "E"
             lngColorIndex = 38
           Case Is = "F"
             lngColorIndex = 39
     
         End Select
       ElseIf .Column > 23 Then

         If .Value <> "" Then
           rngTarget.Interior.ColorIndex = lngColorIndex
         End If
       End If
     End With
   Next rngTarget
 End Sub

【13736】Re:こんな条件に従ってセルの色を塗りつ...
回答  ちゃっぴ E-MAIL  - 04/5/12(水) 12:19 -

引用なし
パスワード
   原因がわかりました。

ループ範囲にRange("x3:id230") を指定していますが、
これは項目名フィールドであるP列を含んでいません。

従って、Column = 16 の条件分岐に処理が行きません。

For Each文のIn以下を以下のように修正してください。

Application.Union(Range("P3:P230"), ("x3:id230"))

Unionメソッドはセル範囲を結合してRANGEオブジェクトとして返すメソッドです。

【13739】Re:こんな条件に従ってセルの色を塗りつ...
質問  くりりん  - 04/5/12(水) 13:15 -

引用なし
パスワード
   >Application.Union(Range("P3:P230"), ("x3:id230"))
としたら、

『コンパイルエラー;型が一致しません』とメッセージが出たのでヘルプを見て

Application.Union(Range("P3:P230"), Range("x3:id230"))

としたら、マクロは実行したのですが、数値の入っているセルが
全て薄い黄色(項目名"D"に指定したColorIndex = 36)になってしまったのですが・・・

【13740】Re:こんな条件に従ってセルの色を塗りつ...
回答  ちゃっぴ E-MAIL  - 04/5/12(水) 13:34 -

引用なし
パスワード
   >Application.Union(Range("P3:P230"), Range("x3:id230"))
>
>としたら、マクロは実行したのですが、数値の入っているセルが
>全て薄い黄色(項目名"D"に指定したColorIndex = 36)になってしまったのですが・・・

すみませんUnionメソッド使用した場合のFor Each文の仕様無視していました。
(*_ _)人ゴメンナサイ

素直に「Range("P3:id230")」を指定してください。

ちなみにUnionメソッドでセル範囲を結合した場合以下のような順序で実行されるみたいです。

P3 → P4 … … P230 → X3 → X4 … … ID230
  

【13741】Re:こんな条件に従ってセルの色を塗りつ...
お礼  くりりん  - 04/5/12(水) 13:55 -

引用なし
パスワード
   ▼ちゃっぴ さん、ありがとうございます!

出、出来ました〜♪(T_T)(感動です!)

それもすごく速く処理できるのでまたまた感動×2です!
自分でぐちゃらぐちゃらと作ったものとは比べ物になりません(^^ゞ

連休明けからずっと悩んでいたので、やっとスッキリしました♪

まだVBA超初心者ですが、この感動を自分で作ったマクロで味わえるように
これから頑張ります(^^ゞ

ちなみに項目名が空欄で数値だけ入力されている場合にも薄い黄色になるのは
なぜなのでしょうか?

【13742】Re:こんな条件に従ってセルの色を塗りつ...
お礼  くりりん  - 04/5/12(水) 14:03 -

引用なし
パスワード
   確かにすごく処理時間がかかります(-_-;)

あと、せっかく修正点を教えていただきましたが、初心者の為
どこをどう修正すればよいのか意味が分からず、修正できませんでした。

でも!ちゃっぴさんの教えていただいた方法で無事出来ましたので
自分の作ったものはそのままお蔵入りにしておきます(^^ゞ

ありがとうございましたm(__)m

【13743】Re:こんな条件に従ってセルの色を塗りつ...
回答  ちゃっぴ E-MAIL  - 04/5/12(水) 14:08 -

引用なし
パスワード
   >ちなみに項目名が空欄で数値だけ入力されている場合にも薄い黄色になるのは
>なぜなのでしょうか?

塗りつぶしを初期化する部分を入れていないからです。
つまり以前に塗るつぶされたデータがそのまま残っている。

解決策としては、初期化Partを追加することです。

プロシジャーの最初に

【データ範囲】.Interior.ColorIndex = xlColorIndexNone '塗りつぶしなし

と書けば、【データ範囲】が塗りつぶしなしになります

【13745】Re:こんな条件に従ってセルの色を塗りつ...
質問  くりりん  - 04/5/12(水) 15:20 -

引用なし
パスワード
   >プロシジャーの最初に
>
>Range("x3:id230").Interior.ColorIndex = xlColorIndexNone '塗りつぶしなし
>
と書いて実行しても、塗りつぶしなしになってから最終的には塗られます。

以前の塗りつぶしが残っているのではないようです。
色々試してみて分かったのですが、数値の入っているセルのp列に項目名が入っていない
場合、項目名の入っているセルの一番近い上の項目名を見て色が塗られているようです。

例えばx4に数値が合ってp4に項目名が無い場合、p3の項目名の色をx4に塗る、
x4:y6に数値が合ってp4:p6に項目名が無い場合、p3の項目名の色をx4:y6に塗る
といった具合です。

これを回避する方法があれば教えて下さい。

【13746】Re:こんな条件に従ってセルの色を塗りつ...
回答  ちゃっぴ E-MAIL  - 04/5/12(水) 16:17 -

引用なし
パスワード
   Select case文の最後に

Case Else
  lngColorIndex = xlColorIndexNone

を追記

これで、項目名が指定の5つ以外の場合、"なし"で塗りつぶします。

【13747】Re:こんな条件に従ってセルの色を塗りつ...
お礼  くりりん  - 04/5/12(水) 16:28 -

引用なし
パスワード
   ちゃっぴ さん、出来ましたぁ〜(^o^)丿
ありがとうございますm(__)m

これで思い通りの結果です(^^ゞ

丸一日に渡り、私のような初心者に最後までお付き合い頂き本当にありがとうございました。(*^。^*)
心より感謝いたしますm(__)m

【13773】Re:こんな条件に従ってセルの色を塗りつ...
回答  Jaka  - 04/5/13(木) 9:52 -

引用なし
パスワード
   >セルに数値を入れれば自動にマクロが実行されるのかな?と思いやってみましたが
そうでもなさそうですし。

そのものズバリです
ただ、標準モジュールではなく、シートモジュールに書きます。
ヘルプは、「Change イベント」。
詳しくは、97だと「Application オブジェクト」の「イベント」の中にありました。

標準でいくつかのシートイベントが用意されています。
使用状況によって、色々使い分けられます。

【13789】Re:こんな条件に従ってセルの色を塗りつ...
お礼  くりりん  - 04/5/13(木) 15:43 -

引用なし
パスワード
   うぉ〜!!(只今感動中(T_T)うるうる)

あ、ありがとうございます!!
標準モジュールではなくシートモジュールに書きなおしてやってみたら、
実行されました♪
Changeイベントのヘルプも見ました。
Changeイベントって便利なんですね〜(*^。^*)

そんなの常識じゃん!って思われるかもしれませんが、VBA初心者の私には
すごく感動しました。

本当にありがとうございましたm(__)m

11847 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free