空白セルに色をつける

質問

B2からG6の範囲でブランクが入っていたらセルに色をつけたいのですが
下記の方法ですと「型が違います」とエラーがでます。
何がいけないのでしょうか？
ご指摘お願い致します。
ちなみにセルの書式設定ではなく今回はVBAで実行させたいのでお願い致します。

If Range("B2:G6") = "" Then

With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

End If

回答No.4

n-jun · ベストアンサー

n-junです。

＞また下記のコードでは他ブランクも色付けされてしまいます。
＞range範囲はブランクをカウントしている下記の部分なのですが
＞n1/n2をひかないと本来指定したい範囲で色付けができません。
ある範囲においてセルが空白且つ”何か”の条件で色をつけるのであれば、
その”何か”を具体的にされては。

それがないと”ひかないと本来指定したい範囲”が、どこなのかわかりません。

回答No.3

n-jun

＃２です。

もしかしてですけど、

Sub try()
Dim 空白セル範囲 As Range

On Error Resume Next
Set 空白セル範囲 = Range("B3:G17").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If Not 空白セル範囲 Is Nothing Then

空白セル範囲.Interior.ColorIndex = 6
MsgBox 空白セル範囲.Cells.Count & "個の未入力セルがあります"
Set 空白セル範囲 = Nothing

End If

End Sub

こうゆう事でしょうか？

回答No.2

n-jun

＃１です。

＞こちらrangeの範囲に変動がありn1 とn2を
＞範囲2 = Range(Cells(c1.Row, 2), Cells(c2.Row, 7))から引かなければならないと思うのですが
質問と補足からでは、なぜ引かなければいけないのかがわかりません。

＞Dim 範囲2 As Range
＞範囲2 = Range(Cells(c1.Row, 2), Cells(c2.Row, 7))
＞Select Case 範囲2
＞Case ""
これも複数のセル範囲の値をまとめて判定しようとしてますよね。

補足

申し訳ありません。
修正する前のコードを載せてしまいました。
下記のコードが n-junさんからのコードを参考にしたものを
先程のコードに追加しました。
当初の質問と違ってはいるのですが本来この中に組み込まなければいけなく、また下記のコードでは他ブランクも色付けされてしまいます。
range範囲はブランクをカウントしている下記の部分なのですが
n1/n2をひかないと本来指定したい範囲で色付けができません。

n = WorksheetFunction.CountBlank( _
Range(Cells(c1.Row, 2), Cells(c2.Row, 7))) - n1 - n2

'★
Dim 範囲2 As Range

For Each 範囲2 In Range(Cells(c1.Row, 2), Cells(c2.Row, 7))

If 範囲2.Value = "" Then
With 範囲2.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If

Next

'★

回答No.1

n-jun

セルの値が空白でありそのセルに色を付けるのなら、１個ずつチェックしなければならないのでは？

＞If Range("B2:G6") = "" Then
まとめて判定しようとしてるからダメなのでしょうね。

Dim r As Range

For Each r In Range("B2:G6")
If r.Value = "" Then
With r.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
Next

とかかな？

補足

ありがとうございます。こちらrangeの範囲に変動がありn1 とn2を
範囲2 = Range(Cells(c1.Row, 2), Cells(c2.Row, 7))から引かなければならないと思うのですが
範囲2 = Range(Cells(c1.Row, 2)-n1, Cells(c2.Row, 7)-n2 としたりしているのですが
うまくいきません。範囲の指定の仕方をご教授頂ければ幸いです。

Sub 集計及びブランクチェック()
Dim 範囲 As Range

Dim r1 As Range, r2 As Range
Dim c1 As Range, c2 As Range
Dim n As Long, n1 As Long, n2 As Long

Set 範囲 = Range("B3").Resize(15, 6) '全範囲

Set r1 = 範囲.Item(1) '先頭セル
Set r2 = 範囲.Item(範囲.Rows.Count, 範囲.Columns.Count) '最後のセル

'データ始まりのセル
Set c1 = 範囲.Find("*", r1, xlFormulas, , xlByRows, xlNext)
If c1 Is Nothing Then Exit Sub
n1 = c1.Column - 2 '前方空白カウント

'最後のデータのあるセル
Set c2 = 範囲.Find("*", 範囲(1), xlFormulas, , xlByRows, xlPrevious)
n2 = 7 - c2.Column '後方空白カウント

n = WorksheetFunction.CountBlank( _
Range(Cells(c1.Row, 2), Cells(c2.Row, 7))) - n1 - n2

'★
Dim 範囲2 As Range

範囲2 = Range(Cells(c1.Row, 2), Cells(c2.Row, 7))

Select Case 範囲2
Case ""
.Value = 範囲2
.Interior.ColorIndex = 6

End Select

'★

If n > 0 Then
MsgBox n & " 個の未入力セルがあります"

End If

End Sub