こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

文字の色を変える

Excel2013です。
A1からA10に文字を入力、となりのB列B1からB10に数字を入力する表があります。
A列の文字がAとBとCが入力された場合、文字の色が赤に、その隣のB列の数字も同じく赤い文字になり、それ以外の文字が入力された場合はそのまま文字の色は黒になる。
VBでどなたか詳しい方教えて下さい。
出来れば、入力してる最中に文字の色が直ぐ変わってくれるようなやり方で教えて欲しいです。
それが難しい場合は全て入力し終わって、シート上にボタンを作り、そのボタンを押すとA列、B列の文字の色が変わるようなやり方をお願いします。

投稿日時 - 2014-05-28 21:33:58

QNo.8614803

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.8

またまたお邪魔します。

>保護を前提に再度教えて頂けないでしょうか?
というコトですので、もう一度コードを変えてください。

尚、F3~G36セルは編集可能にする場合です。
下準備としてF3~G36セルを範囲指定 → 右クリック → セルの書式設定 → 「保護」タブで
「ロック」に入っているチェックを外してください。
(他のセルも編集可能にしたい場合は同様の操作をしておきます。)
その後Sheetの保護を行ってください。

今までのSheetモジュールはすべて消去して↓のコードにします。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Range("F3:F36")) Is Nothing Or Target.Count > 1 Then Exit Sub
ActiveSheet.Unprotect
With Target
Set c = Range("I:I").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Resize(, 2).Font.ColorIndex = xlAutomatic
Else
.Resize(, 2).Font.ColorIndex = 3
End If
End With
ActiveSheet.Protect
End Sub

これでF3~G36セルと「ロック」にチェックが入っていないセルだけが編集可能になり、その他のセルは編集できなくなります。

尚、Sheetの保護の保護でパスワードを設定している場合、仮にパスワードが aaa だとすると
>ActiveSheet.Unprotect
の行を
>ActiveSheet.Unprotect Password:="aaa"

>ActiveSheet.Protect
の行を
>ActiveSheet.Protect Password:="aaa"

としてやります。m(_ _)m

投稿日時 - 2014-06-06 23:46:37

お礼

早速お返事ありがとうございます。

地名が3つほどしかないので、NO.6の上部のコードに教えて頂いたPasswordのコードを追加してやってみました。

ご教授頂いたおかげで思い描いていた書類が出来ました。

tom04さん、何度もありがとうございました。

他のコードはこれからの教材として、参考にさせて頂きます。

本当にありがとうございました。

投稿日時 - 2014-06-07 19:44:08

ANo.7

何度もごめんなさい。

前回のChange範囲は
F3:F36 だけで大丈夫です。

それから前回の後者のコードですが、もっと簡単なコードで大丈夫でした。
もう一度載せておきます。
表の配置は前回通りだとします。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Range("F3:F36")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
Set c = Range("I:I").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Resize(, 2).Font.ColorIndex = xlAutomatic
Else
.Resize(, 2).Font.ColorIndex = 3
End If
End With
End Sub

上記に差し替えてください。m(_ _)m

投稿日時 - 2014-06-05 11:18:35

お礼

丁寧に何度もありがとうございます。

いろいろやってみました。

あまりパソコンに慣れてない人達が使うシートなので、必ずシート保護をかけてみんなに使ってもらってます。

予想もつかない使われ方をされて直すのが大変だからです。

今回のシートも同じく保護をかけて使ってもらうつもりです。


それで、tom04さんに教えていただいたものは、保護を解除するときちんと動くようなプログラムではないでしょうか?

もしそうでしたら、保護を前提に再度教えて頂けないでしょうか?

何度もお時間取らせて申し訳ありません。

投稿日時 - 2014-06-06 22:19:50

ANo.6

続けてお邪魔します。

>実際のセルはF3:G36なので、置き換えてやってみたのですが、上手くできません。
>また、ABCではなく地名なのですが・・・

というコトですがやり方は全く一緒です。
仮に「地名」が 北海道・東京・広島 と3つだけだとするとコードは↓のようになります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, myFlg As Boolean, myArry
If Intersect(Target, Range("F3:G36")) Is Nothing Or Target.Count > 1 Then Exit Sub
myArry = Array("北海道", "東京,", "広島")
i = Target.Row
For k = 0 To UBound(myArry)
If Cells(i, "F") = myArry(k) Then
myFlg = True
Exit For
End If
Next k
If myFlg = True Then
Cells(i, "F").Resize(, 2).Font.ColorIndex = 3
Else
Cells(i, "F").Resize(, 2).Font.ColorIndex = xlAutomatic
End If
End Sub

※ 対象地区が多い場合はいちいちコードに地区名を入力するのではなく、
↓のような感じで表を作成しておきます。(この方が地区の変更にもコードを変更せずに対応できます)
画像ではK列がリストの元の値とし、I列データの場合のみ文字色を「赤」とする方法です。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, c As Range, r As Range
If Intersect(Target, Range("F3:G36")) Is Nothing Or Target.Count > 1 Then Exit Sub
i = Target.Row
Set c = Range("I:I").Find(what:=Cells(i, "F"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Set r = Range("K:K").Find(what:=c, LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
Cells(i, "F").Resize(, 2).Font.ColorIndex = 3
End If
Else
Cells(i, "F").Resize(, 2).Font.ColorIndex = xlAutomatic
End If
End Sub

※ 同じSheetに同じプロシージャは共存できませんので、
どちらか一方のコードにしてください。m(_ _)m

投稿日時 - 2014-06-05 08:58:24

ANo.5

No.1・3・4です。

>対象セルにドロップダウンリストを設定してるんですが・・・

こちらではどのようなSheetになっているのかは判断できませんので
実際に手を動かしてみてください。

前回のコードはChangeイベントですので
対象セルが「Change」した時点でChangeイベントが実行されます。
データの入力規則の「リスト」でデータ変更があった場合でもちゃんと動くはずです。m(_ _)m

投稿日時 - 2014-06-03 09:44:32

お礼

遅くなりました。

新規作成シートでやったらちゃんと出来ました!

実際のセルはF3:G36なので、置き換えてやってみたのですが、上手くできません。

また、ABCではなく地名なのですが、地名に置き換えてやってみたのですが、やっぱり上手くできません。

また、時間をみていろいろやってみます。

投稿日時 - 2014-06-05 00:32:28

ANo.4

No.1・3です。

>標準モジュールにこのコードを書けばよいのでしょうか?

(1)画面左下にある操作したいSheet見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところにコードをコピー&ペーストします。

(2)Alt+F11キー → 画面左側にある操作したいSheet名上でダブルクリック → VBE画面にコードをコピー&ペースト

(1)・(2)のどちらでも大丈夫です。

※ ご自身でコードを入力される場合は
とりあえず上記方法でVBE画面を出す → 画面上側にある「General」と表示されている「オブジェクト」の右側下向き▼で
「WorkSheet」を選択 → その右側の「プロシージャー」の窓(SelectionChange)と表示されている右側の▼で実行したいプロシージャーを選択すると(仮に今回の場合は「Change」を選択)
カーソルが自動で
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
の間に点滅しますので、そこからコードを入力します。m(_ _)m

投稿日時 - 2014-05-31 17:45:31

お礼

ありがとうございます。

対象セルにドロップダウンリストを設定してるんですが、それもクリアにしなければいけないのでしょうか?

投稿日時 - 2014-06-03 07:28:10

ANo.3

No.1です。

>VBの勉強をやり始めたところなんです
というコトですので・・・

色々やり方はあると思いますが、コードを作ってみました。

Changeイベントにしてみました。
シートモジュールです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, myFlg As Boolean, myArray
If Intersect(Target, Range("A1:B10")) Is Nothing Or Target.Count > 1 Then Exit Sub
myArray = Array("A", "B", "C")
With Target
i = Target.Row
Cells(i, "A").Resize(, 2).Font.ColorIndex = xlAutomatic
For k = 0 To UBound(myArray)
If Cells(i, "A") = myArray(k) Then
myFlg = True
Exit For
End If
Next k
If myFlg = True Then
Cells(i, "A").Resize(, 2).Font.ColorIndex = 3
End If
End With
End Sub

※ 条件付き書式が設定してある場合は反応しませんので
条件付き書式の設定はクリアにしておいてください。m(_ _)m

投稿日時 - 2014-05-30 08:33:33

お礼

ちょっと教えて下さい。

標準モジュールにこのコードを書けばよいのでしょうか?

投稿日時 - 2014-05-31 13:48:23

ANo.2

VBAでよろしければ、
シートを右クリック、コードの表示を選択して頂いて
以下のコードを貼り付けてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim word As Variant
Dim cword As Variant
Dim i As Long
Dim flag As Integer
If Target.Cells(1, 1).Column > 1 Then Exit Sub
For i = 1 To Target.Count
word = Split("A,B,C", ",") '■
For Each cword In word
If cword = Target(i) Then
Target(i).Font.Color = RGB(255, 0, 0) '★
Target(i).Offset(0, 1).Font.Color = RGB(255, 0, 0) '★
flag = 1
Exit For
End If
If flag = 0 Then
Target(i).Font.Color = RGB(0, 0, 0) '☆
Target(i).Offset(0, 1).Font.Color = RGB(0, 0, 0) '☆
End If
Next
Next i
End Sub


A列に「A、B、C」のどれかが入力されるとA及びBの文字色が赤色になります。
変更された箇所のみの適応になりますので、すでにデータが入力されている場合は
A列をコピーのち、再度A列に貼り付けてください。
コピー等で複数変更された場合は変更された箇所全て適応されます。


(1)A、B、Cを変更される場合は
コード内の末尾に「■」とある箇所の「" "」内に半角カンマ「,」区切りで文字を設定してください
(増やすことも減らすことも出来ますが、半角カンマを含む文字列は指定できません)

(2)一致した場合の色を変更される場合は
コード内の末尾に「★」とある箇所のRGB(255, 0, 0)の数字を変更してください。
0~255の数字でR(赤要素),G(緑要素),B(青要素)の順で記載願います。
255,0,0は赤、255,255,0は黄、0,255,255は水色、0,255,0は緑、0,0,255は青、255,255,255は白、0,0,0は黒になります。

(3)一致しなかった場合の色を変更される場合は
コード内の末尾に「☆」とある箇所のRGB(0, 0, 0)の数字を変更してください。
((2)と同様です)

投稿日時 - 2014-05-29 09:15:17

お礼

以前にも質問に詳しく教えて頂きまして今回も丁寧に教えて頂きありがとうございます。

まだ、試してないのですが時間のある時にやってみます。

良い勉強になると思います。

eden3616さん、いつもありがとうございます。

投稿日時 - 2014-05-30 07:10:41

ANo.1

こんにちは!

>A列の文字がAとBとCが入力された場合
「A」または「B」または「C」が入力された場合という解釈で良いのでしょうか?

条件付き書式ではダメですか?

A1~B10を範囲指定 → 条件付き書式 → 新しいルール → 「数式を使用して・・・」 → 数式欄に
=OR($A1="A",$A1="B",$A1="C")
という数式を入れ → 書式 → 「フォント」タブ → 色で「赤」を選択しOK

これでとりあえずはお望み通りの表示になると思います。

※ どうしてもVBAで!というコトであれば
Changeイベントを使うやり方でしょうかね。m(_ _)m

投稿日時 - 2014-05-29 08:22:06

お礼

詳しく教えて頂きありがとうございます。

現在、VBの勉強をやり始めたところなんですが、このような場合に応用するやり方が分かりませんでした。

解決しなければ、条件付きでやりたいと思います。

tom04さん、ありがとうございました。

投稿日時 - 2014-05-30 07:04:48

あなたにオススメの質問