Excel2010 VBA 条件色付け

質問

Sub sample()
Dim r As Range

For Each r In Range("q6:q30")
If myIsNumeric(r) Then
r.Offset(0, 1).Value = "数字"
Else
r.Offset(0, 1).Value = "文字"
End If
Next

End Sub

Function myIsNumeric(Target As Range)
Dim r As Range
Dim buf, tmp
Dim flg As Boolean
Dim i As Integer

buf = Target

For i = 1 To Len(buf)
tmp = Mid(buf, i, 1)
If IsNumeric(tmp) Then
flg = True
Exit For
End If
Next

myIsNumeric = flg
End Function

を数字が入ってたら塗りつぶさないで、
数字が入ってなかったら塗りつぶすように直したいです。

あああ→塗る
あああ1－1→塗らない
住所→塗る
住所12→塗らない

回答No.1

kagakusuki · ベストアンサー

>数字が入ってなかったら塗りつぶすように

との事ですが、何色に塗りつぶす様にすれば宜しいのでしょうか？
　例えば赤色で塗り潰す様にするのであれば以下の様なVBAとなります。

Sub sample()
Dim buf, r As Range, flg As Boolean, i As Integer

For Each r In Range("Q6:Q30")
flg = True
If r <> "" Then
For i = 0 To 9
If InStr(StrConv(r, vbNarrow), i) > 0 Then
flg = False
Exit For
End If
Next i
If flg Then r.Interior.Color = 255
End If
Next

End Sub

　それから、御質問の件であれば、VBAなど使わずとも条件付き書式を使えば良いのではないでしょうか？

Q6セルを選択
　　↓
Excelウインドウの [ホーム]タブをクリック
　　↓
現れた「スタイル」グループの中にある[条件付き書式]ボタンをクリック
　　↓
現れた選択肢の中にある[ルールの管理]をクリック
　　↓
現れた「条件付き書式ルールの管理」ダイアログボックスの中にある[新規ルール]ボタンをクリック
　　↓
現れた「新しい書式ルール」ダイアログボックスの「ルールの種類を選択してください」欄の中にある[数式を使用して、書式設定するセルを決定]を選択してクリック
　　↓
現れた「次の数式を満たす場合に値を書式設定」欄に

=AND(Q6<>"",SUMPRODUCT(ISNUMBER(FIND(ROW(INDIRECT("A1:A10"))-1,Q6))*1)=0)

と入力
　　↓
「新しい書式ルール」ダイアログボックスの[書式]ボタンをクリック
　　↓
現れた「セルの書式設定」ダイアログボックスの[塗りつぶし]タブをクリック
　　↓
現れた背景色のサンプルの中から塗りつぶしたい色と同色の四角形をクリック
　　↓
「セルの書式設定」ダイアログボックスの[OK]ボタンをクリック
　　↓
「新しい書式ルール」ダイアログボックスの[OK]ボタンをクリック
　　↓
「条件付き書式ルールの管理」ダイアログボックスの中にある「適用先」欄をクリック
　　↓
Q6～Q30のセル範囲をまとめて範囲選択
　　↓
「条件付き書式ルールの管理」ダイアログボックスの中にある[適用]ボタンをクリック
　　↓
「条件付き書式ルールの管理」ダイアログボックスの中にある[OK]ボタンをクリック

お礼

ありがとうございます。できました。

VBAでなければいけなかったので質問しました。