エクセルについて教えて下さい。

質問

A1～A10・B1～B10・C1～C10の中に、７月から１０月までの日にちをランダムに入力します。
A1～C10のセルに、同じ日にちが４つ以上入力されたときに、警告として、その日付が赤字に表示、または警告するようにするには、どうしたらいいのでしょうか。

よろしくお願いします。

回答No.3

mu2011 · ベストアンサー

>同じ日にちが４つ以上入力されたときにその日付が赤字に表示
⇒方法１
　（１）A1:C10範囲を選択→書式→条件付き書式
　（２）「数式が」を選択、数式欄に=COUNTIF($A$1:$C$10,A1)>=4
　（３）書式→フォントタブの色欄で赤色を選択、又はセル背景を色付けする場合はパターンタブで赤色を選択→ＯＫ
⇒方法２
　（１）A1:C10範囲を選択→データ→入力規則
　（２）「ユーザ設定」を選択、数式欄に=COUNTIF($A$1:$C$10,C3)<4、→ＯＫ
　（蛇足）エラーメッセージタブで任意警告メッセージを登録 ※省略可能

お礼

ありがとうございました。
条件付き書式で、作成することにしました。

回答No.7

imogasi

私もCOUNTIF利用を思いついてやって見たが、４つ目には、４つとも（例）セルに色が付いた。ランダムに入力するときは、最後（４つめ）がどれか判りにくい。
普通は最後は今入れたセルで覚えているだろうが。
ーー
最終入れたセルを色づけたたい、とやってみたが
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column >= 1 And Target.Column <= 3 And Target.Row >= 1 And Target.Row <= 10 Then
If Application.CountIf(Range("A1:c10"), Target) >= 4 Then
Target.Interior.ColorIndex = 6
End If
End If
End Sub
では、４つ以上あってどれか（もちろん同じ値）削除したとき、色を
削除することが無い。これを盛り込もうとするとうまくいかない。
Changeイベントではセルの値を削除したセルの元の値がTargetでは捉えられないので難しそうで断念した。普通の使い方なら、下記で使えるかな。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column >= 1 And Target.Column <= 3 And Target.Row >= 1 And Target.Row <= 10 Then
If Target = "" Then
Target.Interior.ColorIndex = xlNone
Else
If Application.CountIf(Range("A1:c10"), Target) >= 4 Then
Target.Interior.ColorIndex = 6
End If
End If
End If
End Sub

お礼

いろいろと、ありがとうございました。
簡単な条件付き書式で、作成することにしました。

回答No.6

mshr1962

例えば条件付き書式でA1:C10の条件を
「数式が」「=AND(COUNTIF($A$1:$C$10,A1)>3,ISNUMBER(A1))」としてセルの書式を設定
4つ以上入力された日付のセルの書式が変わります。

警告表示なら、「データ」「入力規則」を入力値の種類をユーザー設定で
数式を「=AND(COUNTIF($A$1:$C$10,A1)<4,ISNUMBER(A1))」
でエラーメッセージタブで警告文を設定する。

お礼

ありがとうございました。
条件付き書式で、作成することにしました。

回答No.5

mu2011

NO3です。言葉足らずでしたので補足します。
方法１は、同一日付が４つ以上となった場合に対象の全セルに色着けします。
方法２は、同一日付が３つまでを入力可能として４つ目を入力した時点で警告メッセージを表示します。
警告レベルは、停止・注意・情報（エラーメッセージタブ）があり、デフォルトは「停止」ですのでその他レベルもお試し下さい。

回答No.4

noname#192382

次のマクロでできましたよ。

Option Explicit

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2008/5/2 ユーザー名 :
'
'
Range("A1:A10").Select
Selection.Copy
Range("E1:E10").Select
ActiveSheet.Paste
Range("B1:B10").Select
Application.CutCopyMode = False
Selection.Copy
Range("E11:E20").Select
ActiveSheet.Paste
Range("c1:c10").Select
Application.CutCopyMode = False
Selection.Copy
Range("E21:E30").Select
ActiveSheet.Paste

Columns("E:E").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
Dim mygyo As Integer, mygyo4 As Integer
For mygyo = 1 To 30
mygyo4 = mygyo + 3
If Cells(mygyo, 5) = Cells(mygyo4, 5) Then
'akaji
MsgBox "4つ以上の重複"
Else
End If
Next mygyo
End Sub

お礼

いろいろと、ありがとうございました。
簡単な条件付き書式で、作成することにしました。

回答No.2

higekuman

COUNTIF関数と条件付き書式でできますよ。

お礼

ありがとうございました。
条件付き書式で、作成することにしました。

回答No.1

hide0824

通りすがりに拝見しました。
関数のVLOOKUPとIFを組み合わせれば可能だと思います

お礼

ありがとうございました。
条件付き書式で、作成することにしました。