日付を入力したら別のセルに色を

質問

下記内容でご指導頂けませんか。
XP EXCELL2003

B２に日付(８／１０)を入力したらA2に月度(０８)でセルに色をつけたいのですが、この場合　月度は１２ヶ月分ありセルのカラーも当然１２ヶ必要になります。
例
B2に8/10と入力したらA2のセルは赤色

エクセル２００３の条件付書式が３個しか出来ません。
関数で何かいい方はないでしょうか。

よろしく御願いいたします。

回答No.6

merlionXX · ベストアンサー

> １月の場合、フオントが黒でマクロで白に出来たら

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
If Target.Column <> 2 Then Exit Sub
If Target.Value = "" Then
c = 0
Else
On Error GoTo line
Select Case Month(Target.Value)
Case 1: c = 1
Case 2: c = 4
Case 3: c = 5
Case 4: c = 6
Case 5: c = 7
Case 6: c = 8
Case 7: c = 9
Case 8: c = 3
Case 9: c = 10
Case 10: c = 12
Case 11: c = 13
Case 12: c = 14
End Select
End If
Target.Offset(0, -1).Interior.ColorIndex = c
Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0)
Exit Sub
line:
Target.Offset(0, -1).Interior.ColorIndex = 0
Target.Offset(0, -1).Font.ColorIndex = 0
End Sub

ではいかが？

お礼

私のわがままを聞いていただき誠に有難うございました。
色々と勉強になりました。
少しはお陰でアップになりました。

回答No.5

merlionXX

> B2といってましたが今の処　B2000　まで予定しています。
> 場合によっては B2000 以上になる可能性もあります。

では、B列全部を対象にします。
で、色を変えるのもA2限定でなく、入力したセルの左隣のセルということでなのでしょうか？

とりあえずそのような前提で、以下のように変更します。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
If Target.Column <> 2 Then Exit Sub
If Target.Value = "" Then
c = 0
Else
On Error GoTo line
Select Case Month(Target.Value)
Case 1: c = 1
Case 2: c = 4
Case 3: c = 5
Case 4: c = 6
Case 5: c = 7
Case 6: c = 8
Case 7: c = 9
Case 8: c = 3
Case 9: c = 10
Case 10: c = 12
Case 11: c = 13
Case 12: c = 14
End Select
End If
Target.Offset(0, -1).Interior.ColorIndex = c
Exit Sub
line:
Target.Offset(0, -1).Interior.ColorIndex = 0
End Sub

補足

うまくいきました。
本当に未熟者のにお付き合い有難うございました。

恐縮ですが少し贅沢を言わせていただくと例えば１月の場合、フオントが黒でマクロで白に出来たら見やすくなりより良いのですが。

もしもしお時間があればご協力頂けれると幸いです。
本当に勝手な御願いです。

回答No.4

merlionXX

merlionXXです。

> あなたにご指導いただいたのを追加したいのですが可能ならばどういうようにすればいいか教えていただけませんか。

該当のシートのモジュールにコピペしてみてください。と書いたのですが・・・。
あなたが提示されたマクロ（ダブルクリックで作動するものだと思います）はそのままにして、その下に貼り付けてみてください。

補足

何とか色々とトライしてうまくいきました。

私の説明不足で済みません
B2といってましたが今の処　B2000　まで予定しています。
場合によっては B2000 以上になる可能性もあります。

本当に何回も申し訳ありませんが追加のマクロお教え願いませんか。
よろしく御願いします。

回答No.3

cistronezk

１２色にしないことで一体どんな損失が発生するのかは部外者には想像もつきませんが、３色を使いまわすのでは駄目なのでしょうか？
条件付き書式で、
「数式が」「=MOD(MONTH(B2),3)=0」＜色１＞
「数式が」「=MOD(MONTH(B2),3)=1」＜色２＞
「数式が」「=MOD(MONTH(B2),3)=2」＜色３＞
とすれば、３色を回して使うことが出来ます。

お礼

分からない人もいるのでより分かりやすくしたいと思いカラーにしたかったのです。
B2～B2000で説明不足でした。
ご協力有難うございました。

回答No.2

merlionXX

マクロの一例です
該当のシートのモジュールにコピペしてみてください。
なお、色の変更はC=のあとの数字がカラーインデックスです。
8月はご指定の赤にしましたがあとはバラバラですのでそちらで適当に修正してください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
If Target.Address <> "$B$2" Then Exit Sub
If Target.Value = "" Then
c = 0
Else
On Error GoTo line
Select Case Month(Target.Value)
Case 1: c = 1
Case 2: c = 4
Case 3: c = 5
Case 4: c = 6
Case 5: c = 7
Case 6: c = 8
Case 7: c = 9
Case 8: c = 3
Case 9: c = 10
Case 10: c = 12
Case 11: c = 13
Case 12: c = 14
End Select
End If
Range("A2").Interior.ColorIndex = c
Exit Sub
line:
Range("A2").Interior.ColorIndex = 0
End Sub

補足

今現在、下記のマクロが入力されています。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long
Dim r As Byte
i = Sheets("入金記入").Range("B65536").End(xlUp).Row + 1
r = Target.Row
If Target.Value = "入金済" Then
With Sheets("入金記入")
.Cells(i, 2).Value = Date
.Cells(i, 3).Value = Cells(r, 3).Value
.Cells(i, 4).Value = Cells(r, 4).Value
End With
End If
End Sub

あなたにご指導いただいたのを追加したいのですが可能ならばどういうようにすればいいか教えていただけませんか。
マクロは分からないので恐れ入ります。
あなたに教えていただいた物だけなら作動しました。
是非これを生かしたいです。

回答No.1

KURUMITO

エクセル2007にするかマクロを使って対応することになるでしょう。

お礼

アドバイス有難うございました。

補足

マクロは全然分からずここで下記のマクロをご指導いただきました。
もし下記に追加できるのならお手数ですがご指導いただけませんか。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long
Dim r As Byte
i = Sheets("入金記入").Range("B65536").End(xlUp).Row + 1
r = Target.Row
If Target.Value = "入金済" Then
With Sheets("入金記入")
.Cells(i, 2).Value = Date
.Cells(i, 3).Value = Cells(r, 3).Value
.Cells(i, 4).Value = Cells(r, 4).Value
End With
End If
End Sub

よろしく御願いします。