条件に当てはまるセルにColorIndex = 4の色をつけたい。

質問

よろしくお願いします。

Excel2003にて製作したシート1のA列（縦方向）に数字の「1」がランダ

ムに数カ所はいっているのですが、「1」がはいっているセルに

ColorIndex = 4をつけたいのです。「1」の位置はA列のなかで毎日数カ

所とも移動します。

関数ではなくVBAコードにておたずねしたいと思います。

回答お願いします。

回答No.2

onlyrom · ベストアンサー

＞シート1のA列（縦方向）に数字の「1」がランダムにある

ということなら、色付け云々の前に、質問者の提示したコードでは
上手くいかないような。。。。(^^;;;
（Ａ列がソートしてあれば別）
それに、何をしたいのかがコードからはいまいち読み取れない。

ま、それは置いといて質問の件。

一度に色を付けずに処理をしながら色付けするなら、
以下の●のところに１行追加するだけでいいでしょう。

'-----------------------------------------------

Do While (Sheet1.Cells(i, 2).Value <> "")
If (Sheet1.Cells(i, 1).Value = 1) Then

●●これを追加
　　Sheet1.Cells(i,1).Interior.ColorIndex = 4

Select Case j Mod 3
Case 1
　　以下、略
'------------------------------------------

それから、老婆ながら一言いわせてもらうと、
変数名の付けかたに問題があります。
Sheet1,Sheet2というのはシートのオブジェクト名ですから
mySheet1とかmySheet2とか別な名前にしましょう。

以上。

お礼

こんな問いにおつきあい下さいましてありがとうございました。
若僧ながら感謝いたします。

回答No.3

imogasi

>関数ではなくVBAコードにておたずねしたいと思います。
（１）VBA でも普通は条件付書式というのがあるのでそれを使うはずだ。
マクロの記録をとれば判る。A列対象範囲（最下行）が変わるぐらいでしょう。
（２）A列のセルの値のChangeイベントをつかまえて
色をつける方法もある。折角のVBAなんだから（１）でやるべきです。
（３）どうも質問者のコードでは、毎日一回？起動をかけて、実行しないとならなくなるのかも。
ーー
＃１のお礼の長いコードはなに？他の処理も含まれているのかな。読む根気も起こらない。（１）のコードでは数行で終ると思うが。

お礼

アドバイスありがとうございます。

回答No.1

redfox63

Rangeオブジェクトでシートのセル範囲を取得します
Valueプロパティからセルに記入されている データを取得します
これを Forなどで回して該当部分の Rangeオブジェクトの Interior.ColorIndexを希望の色に設定しましょう

たとえば
　　dim r as Range, n as integer , v as variant
　　Set r = Sheet1.Range("A1", _
　　　　Sheet1.Range("A65536").End　(xlUp) )
　　v = r.value
　　for n = 1 to UBound( r )
　　　　if v(n,1) = 1 then
　　　　　　r(n).interior.Colorindex = 4
　　　　end if
　　Next
といった具合です

補足

ご回答ありがとうございます。
下記コードにあてはめようとしましたが「配列がありません」とエラーがでてしまいます。いろいろ試しましたが解決しません。どのようにうまく組み込むとよいでしょうか。UBoundの部分がひっかっかているのでしょうか。
長いコードですがおつきあいよろしくお願い致します。

Sub 合計請求書印刷4月()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("4月")
Set Sheet2 = ThisWorkbook.Worksheets("合計請求書")
Dim baseRow As Long

' 7行目から、2列目(顧客名)が空になるまでループ
baseRow = 7
i = baseRow
j = 1
Do While (Sheet1.Cells(i, 2).Value <> "")
If (Sheet1.Cells(i, 1).Value = 1) Then

Select Case j Mod 3

Case 1
Sheet2.Range("W8").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B15").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("W15").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("G15").Value = Sheet1.Cells(i, 9).Value
Case 2
Sheet2.Range("W25").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B32").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("W32").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("G32").Value = Sheet1.Cells(i, 9).Value

Case 0
Sheet2.Range("W42").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B49").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("W49").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("G49").Value = Sheet1.Cells(i, 9).Value
' 印刷プレビュー
Sheet2.PrintPreview

Case Else
End Select
j = j + 1
End If
i = i + 1

Loop

If j Mod 3 = 1 Then
End

Set Sheet2 = Nothing
Set Sheet1 = Nothing

Else
Sheet2.Range("W42").Value = ""
Sheet2.Range("B49").Value = ""
Sheet2.Range("W49").Value = ""
Sheet2.Range("G49").Value = ""

If j Mod 3 = 2 Then
Sheet2.Range("W25").Value = ""
Sheet2.Range("B32").Value = ""
Sheet2.Range("W32").Value = ""
Sheet2.Range("G32").Value = ""

End If

Sheet2.PrintPreview
End If

Set Sheet2 = Nothing
Set Sheet1 = Nothing

End Sub

ご教授お願い致します。