Excel VBA質問箱 IV

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

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


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

【32723】複数の条件を設定してセルに色を付けたい SWX 05/12/21(水) 12:15 質問[未読]
【32724】Re:複数の条件を設定してセルに色を付けたい Statis 05/12/21(水) 12:24 発言[未読]
【32727】Re:複数の条件を設定してセルに色を付けたい SWX 05/12/21(水) 12:54 お礼[未読]
【32731】Re:複数の条件を設定してセルに色を付けたい RIVER 05/12/21(水) 13:40 質問[未読]
【32732】Re:複数の条件を設定してセルに色を付けたい Kein 05/12/21(水) 13:56 回答[未読]
【32742】Re:複数の条件を設定してセルに色を付けたい RIVER 05/12/21(水) 14:42 お礼[未読]

【32723】複数の条件を設定してセルに色を付けたい
質問  SWX  - 05/12/21(水) 12:15 -

引用なし
パスワード
   はじめまして。

Sheet1のセルA1にAと入力するとセルB1:F1の色が赤色に、Bと入力すると青色、Cと入力すると黄色、Dと入力すると緑色・・・のような複数の条件を設定するにはどのようなマクロを組めば良いのでしょうか?

エクセルのバージョンは2000、OSはWinMEです。

ご存知の方ご教授願います。

【32724】Re:複数の条件を設定してセルに色を付け...
発言  Statis  - 05/12/21(水) 12:24 -

引用なし
パスワード
   ▼SWX さん:
こんにちは
>はじめまして。
>
>Sheet1のセルA1にAと入力するとセルB1:F1の色が赤色に、Bと入力すると青色、Cと入力すると黄色、Dと入力すると緑色・・・のような複数の条件を設定するにはどのようなマクロを組めば良いのでしょうか?
>
>エクセルのバージョンは2000、OSはWinMEです。
>
>ご存知の方ご教授願います。


該当のシートイベントに記載して下さい。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Co As Integer
With Target
   If .Address(0, 0) <> "A1" Then Exit Sub
   Select Case .Value
      Case "A": Co = 3
      Case "B": Co = 5
      Case "C": Co = 6
      Case "D": Co = 10
      Case Else: Co = 0
   End Select
   .Offset(, 1).Resize(, 5).Interior.ColorIndex = Co
End With
End Sub

【32727】Re:複数の条件を設定してセルに色を付け...
お礼  SWX  - 05/12/21(水) 12:54 -

引用なし
パスワード
   ▼Statis さん:
はじめまして。親切に教えて下さりおかげで助かりました。
本当にありがとうございました。

>▼SWX さん:
>こんにちは
>>はじめまして。
>>
>>Sheet1のセルA1にAと入力するとセルB1:F1の色が赤色に、Bと入力すると青色、Cと入力すると黄色、Dと入力すると緑色・・・のような複数の条件を設定するにはどのようなマクロを組めば良いのでしょうか?
>>
>>エクセルのバージョンは2000、OSはWinMEです。
>>
>>ご存知の方ご教授願います。
>
>
>該当のシートイベントに記載して下さい。
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>Dim Co As Integer
>With Target
>   If .Address(0, 0) <> "A1" Then Exit Sub
>   Select Case .Value
>      Case "A": Co = 3
>      Case "B": Co = 5
>      Case "C": Co = 6
>      Case "D": Co = 10
>      Case Else: Co = 0
>   End Select
>   .Offset(, 1).Resize(, 5).Interior.ColorIndex = Co
>End With
>End Sub

【32731】Re:複数の条件を設定してセルに色を付け...
質問  RIVER  - 05/12/21(水) 13:40 -

引用なし
パスワード
   解決している質問に対し、重ねて質問してすみません。
下のセルA1に入力したらセルB1:F1に色が付くマクロですが、続けてセルA2、セルA3、
A4・・・に同じ条件を設定するにはどういったマクロを追加すればいいか教えて頂けますか。


>▼Statis さん:
>はじめまして。親切に教えて下さりおかげで助かりました。
>本当にありがとうございました。
>
>>▼SWX さん:
>>こんにちは
>>>はじめまして。
>>>
>>>Sheet1のセルA1にAと入力するとセルB1:F1の色が赤色に、Bと入力すると青色、Cと入力すると黄色、Dと入力すると緑色・・・のような複数の条件を設定するにはどのようなマクロを組めば良いのでしょうか?
>>>
>>>エクセルのバージョンは2000、OSはWinMEです。
>>>
>>>ご存知の方ご教授願います。
>>
>>
>>該当のシートイベントに記載して下さい。
>>
>>Private Sub Worksheet_Change(ByVal Target As Range)
>>Dim Co As Integer
>>With Target
>>   If .Address(0, 0) <> "A1" Then Exit Sub
>>   Select Case .Value
>>      Case "A": Co = 3
>>      Case "B": Co = 5
>>      Case "C": Co = 6
>>      Case "D": Co = 10
>>      Case Else: Co = 0
>>   End Select
>>   .Offset(, 1).Resize(, 5).Interior.ColorIndex = Co
>>End With
>>End Sub

【32732】Re:複数の条件を設定してセルに色を付け...
回答  Kein  - 05/12/21(水) 13:56 -

引用なし
パスワード
   イベント発生を許可するセルを、複数の範囲(仮にA1:A10)にしたければ

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Co As Integer
 Dim C As Range

 If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
 For Each C In Target
   Select Case C.Value
    Case "A": Co = 3
    Case "B": Co = 5
    Case "C": Co = 6
    Case "D": Co = 10
    Case Else: Co = 0
   End Select
   C.Offset(, 1).Resize(, 5).Interior.ColorIndex = Co
 Next
End Sub

などとします。

【32742】Re:複数の条件を設定してセルに色を付け...
お礼  RIVER  - 05/12/21(水) 14:42 -

引用なし
パスワード
   ▼Kein さん:
ありがとうございます。大いに参考になりました。
またわからないことがあったときはよろしくお願いします。

>イベント発生を許可するセルを、複数の範囲(仮にA1:A10)にしたければ
>
>Private Sub Worksheet_Change(ByVal Target As Range)
> Dim Co As Integer
> Dim C As Range
>
> If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
> For Each C In Target
>   Select Case C.Value
>    Case "A": Co = 3
>    Case "B": Co = 5
>    Case "C": Co = 6
>    Case "D": Co = 10
>    Case Else: Co = 0
>   End Select
>   C.Offset(, 1).Resize(, 5).Interior.ColorIndex = Co
> Next
>End Sub
>
>などとします。

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