【再】連続する同じ数字のセルの塗り潰しがしたい。

質問

先程は、質問の添付図が添付されていなかたので再掲載します。
＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠
このカテゴリーのエクセルの達人の方々に質問です。
どなたか回答して頂ける方がお見えでしたら回答よろしくお願いします。
（ちゃんとした回答ではなく、文句やクレーム等を混ぜた記載はご遠慮ください。
　また私の質問が気に入らない場合は無視して頂ければ結構です。）
【質問】
　添付図のとおり、４行×２５列の中に数字が１～31まであり、重複して入っています。
　この中にある数字で、同じ数字が縦・右斜め・左斜め（横は無い）のいずれかに該当すれば
　その数字のセルを黄色で塗り潰す方法をＶＢＡで実現する方法が知りたいです。

【注意事項】
　　・４行×２５列の中にある数字の並びは毎回異なります。
　　・ＶＢＡで実現する方法～、と書きましたが、
　　　同様のことが他の方法でも実現できればそれを教えて下さい。
　　・使用するエクセルは２０２１です。

以上、よろしくお願いします。

回答No.3

kkkkkm · ベストアンサー

VBAだと(冗長なコードかもしれませんが思いつくままのコードです)
実行時の画像は回答No.2と同じなので省略します。

Sub Test()
Dim i As Long
Dim c As Range

Range("A1:Y4").Interior.ColorIndex = xlNone

For Each c In Range("A1:Y4")
If c.Row <> 1 And c.Column <> 1 Then
If c.Value = c.Offset(-1, -1).Value _
Or c.Value = c.Offset(-1, 0).Value _
Or c.Value = c.Offset(-1, 1).Value _
Or c.Value = c.Offset(1, -1).Value _
Or c.Value = c.Offset(1, 0).Value _
Or c.Value = c.Offset(1, 1).Value _
Then
c.Interior.Color = vbYellow
End If
ElseIf c.Row = 1 Then
If c.Column <> 1 Then
If c.Value = c.Offset(1, 0).Value _
Or c.Value = c.Offset(1, 1).Value _
Or c.Value = c.Offset(1, -1).Value _
Then
c.Interior.Color = vbYellow
End If
Else
If c.Value = c.Offset(1, 0).Value _
Or c.Value = c.Offset(1, 1).Value _
Then
c.Interior.Color = vbYellow
End If
End If
ElseIf c.Column = 1 Then
If c.Row <> 1 Then
If c.Value = c.Offset(1, 0).Value _
Or c.Value = c.Offset(1, 1).Value _
Or c.Value = c.Offset(-1, 0).Value _
Or c.Value = c.Offset(-1, 1).Value _
Then
c.Interior.Color = vbYellow
End If
End If
End If
Next
End Sub

お礼

ＶＢＡ実行して上手くいきました。 ありがとうございます。

Powered by GRATICA

回答No.2

kkkkkm

> Ａ４～Ｙ４の間にあるセルに全く黄色がつかず、
> Q2：４に黄色がついたり、Ｂ２：１１に黄色がつかなかったりします。

こちらではついているのですが・・・。画像を添付します。
もしかして数式を入れた後で範囲の指定を変更しませんでしたか？
その場合数式も変更されてしまいます。

あとテスト不足でA1が反応しませんでした。
画像は確認のためにA1を11にしています。

範囲を=$A$1
で式を
=AND(A1<>0,OR(A1=OFFSET(A1,1,0),A1=OFFSET(A1,1,1)))
を追加してください

回答No.1

kkkkkm

条件つき書式の「数式で・・・」を利用して

範囲を=$B$2:$Y$4で
数式を
=AND(B2<>0,OR(B2=OFFSET(B2,-1,-1),B2=OFFSET(B2,-1,0),B2=OFFSET(B2,-1,1),B2=OFFSET(B2,1,-1),B2=OFFSET(B2,1,0),B2=OFFSET(B2,1,1)))

範囲を=$A$1:$Y$1で
数式を
=AND(A1<>0,OR(A1=OFFSET(A1,1,-1),A1=OFFSET(A1,1,0),A1=OFFSET(A1,1,1)))

範囲を=$A$1:$A$4で
数式を
=AND(A1<>0,OR(A1=OFFSET(A1,-1,0),A1=OFFSET(A1,-1,1),A1=OFFSET(A1,1,0),A1=OFFSET(A1,1,1)))

の3個のルールででいけそうですので試してみてください。

お礼

間違いの指摘に続き、早速の回答ありがとうございます。教えていただいたやり方を早速試してみます。

Powered by GRATICA

補足

早速、条件付き書式-数式を利用して～　から、
上記３つのルールを入れてみましたが、
Ａ４～Ｙ４の間にあるセルに全く黄色がつかず、
Q2：４に黄色がついたり、Ｂ２：１１に黄色がつかなかったりします。