EXCELで日付ごとに行の色分けを行うには？

質問

下記のような表でB列に入力してある日付をもとに行の色分けをしたいと考えています。
条件書式やVBAを試してみましたがどのようにしたらよいかわかりません。
どなたか教えていただけませんでしょうか。宜しく御願い致します。

A |　　　B 　　 |　　　C
ABC |　20120903　| 1
DEF |　20120903　| 3
GHI |　20120904　| 7
JKL |　20120905　| 3
MNO |　20120905　| 5
OPQ |　20120910　| 6

回答No.2

tom04 · ベストアンサー

こんばんは！
No.1さんのお礼欄に
＞日付を自動で認識して交互に行の色分けができるとありがたいです・・・

とありますので、お邪魔します。

一例です。
1行目はタイトル行でデータは2行目以降にあるとします。
B列データは昇順に並んでいるとして、

Sub 色分け()
Dim i As Long
Dim j As Long

Application.ScreenUpdating = False
Cells.Interior.ColorIndex = xlNone
j = Cells(1, Columns.Count).End(xlToLeft).Column
Cells(2, 1).Resize(1, j).Interior.ColorIndex = 36 '←薄い黄色にしています。

For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 2) = Cells(i - 1, 2) Then
With Cells(i, 1).Resize(1, j)
.Interior.ColorIndex = .Offset(-1).Interior.ColorIndex
End With
ElseIf Cells(i - 1, 1).Interior.ColorIndex = xlNone Then
Cells(i, 1).Resize(1, j).Interior.ColorIndex = 36
End If
Next i
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

ありがとうございました。無事に解決致しました。

回答No.3

K Kazz（@JazzCorp）

こんな感じ、、、？？？、、、

Option Explicit
Sub HighlightHeavy()
Const xKey_Row = 2
Const xKey_Col = "B"
Const xBlack = 1
Const xWhite = 2
Const xBlue = 5
Const xYellow = 6
Dim kk As Long
Dim nn As Long
Dim xBefre As Boolean
Dim xLast As Long
Dim xRight As Long
xLast = Cells(Rows.Count, xKey_Col).End(xlUp).Row
xRight = Cells(1, Columns.Count).End(xlToLeft).Column
If (xLast <= xKey_Row) Or (xRight < Range(xKey_Col & "1").Column) Then
MsgBox ("No Data Found!!")
Exit Sub
End If
For nn = xKey_Row To xLast
'日付は文字列でもOK？
If (Cells(nn, xKey_Col).Value = Cells(nn + 1, xKey_Col).Value) And (Cells(nn, xKey_Col).Value <> Empty) Then
'どちらもハイライト
For kk = 1 To xRight
Cells(nn, kk).Font.Bold = True
Cells(nn, kk).Font.ColorIndex = xYellow
Cells(nn, kk).Interior.ColorIndex = xBlue
Next kk
xBefre = True
Else
If (xBefre) Then
'直前一致あり：借りを返済
For kk = 1 To xRight
Cells(nn, kk).Font.Bold = True
Cells(nn, kk).Font.ColorIndex = xYellow
Cells(nn, kk).Interior.ColorIndex = xBlue
Next kk
xBefre = False
Else
'前の状態に関係なくリセット
For kk = 1 To xRight
Cells(nn, kk).Font.Bold = False
Cells(nn, kk).Font.ColorIndex = xBlack
Cells(nn, kk).Interior.ColorIndex = xWhite
Next kk
End If
End If
Next nn
End Sub

お礼

2回に渡っての回答ありがとうございました。

回答No.1

K Kazz（@JazzCorp）

例えば、
Option Explicit
Sub HighlightHeavy()
Const xKey_Row = 2
Const xKey_Col = "B"
Const xBlack = 1
Const xWhite = 2
Const xBlue = 5
Const xYellow = 6
Dim kk As Long
Dim nn As Long
Dim xLast As Long
Dim xRight As Long
xLast = Cells(Rows.Count, xKey_Col).End(xlUp).Row
xRight = Cells(1, Columns.Count).End(xlToLeft).Column
For nn = xKey_Row To xLast
Select Case Cells(nn, xKey_Col).Value
Case "20120905"
For kk = 1 To xRight
Cells(nn, kk).Font.Bold = True
Cells(nn, kk).Font.ColorIndex = xYellow
Cells(nn, kk).Interior.ColorIndex = xBlue
Next kk
Case Else
For kk = 1 To xRight
Cells(nn, kk).Font.Bold = False
Cells(nn, kk).Font.ColorIndex = xBlack
Cells(nn, kk).Interior.ColorIndex = xWhite
Next kk
End Select
Next nn
End Sub

お礼

回答ありがとうございます。
説明不足で申し訳ありません。
データが1000行以上あるため、日付を自動で認識して交互に行の色分けができるとありがたいです。質問の表では、A2：C3、A4:C4、A5:C6、A７：C7を交互に色分けになります。お手数ですが、この条件に対応できるようにしていただけますでしょうか。