macroについて教えてください

質問

こんにちは。以前こちらでPrivate SubについてMacroを教えていただきました。（あの後ログインパスワード等が不明になりお礼も出来ませんでしたが。。。回答頂いた方すみませんでした。）

下記がそのMacroですが、今回また少し変えることになり
どのように変えていいのか分かりません。
前回は1～5はグレー、6～10は茶色・・・という形にしたのですが
今回は進捗率での管理をしたく、80％以下は白、80～90％は赤、90～100％は青としたいと思っています。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColors As Variant
Dim rw As Long
Dim CellCnt As Integer
Dim col As Integer
Dim col2 As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim c As Variant
Dim ar() As Variant
Dim Sh1 As Worksheet
Set Sh1 = Worksheets("小児科Dr")
col = Target.Cells(1).Column
'制限された列
If Not (col = 4 Or col = 8 Or col = 12 Or col = 16) Then Exit Sub
iColors = Array(16, 16, 16, 16, 16, 53, 53, 53, 53, 53, 54, 54, 54, 54, 54)
CellCnt = Target.Count
ReDim ar(CellCnt - 1)
For Each c In Target
If c.Value <> "" Then
If IsNumeric(c.Value) Then
i = c.Value
If i >= 11 Then
i = 10
End If
If i > 0 And i < 11 Then
j = iColors(i - 1)
Else
j = 2
End If
ar(k) = j
k = k + 1
End If
End If
Next c
rw = Target.Row
Select Case col
Case 4: col2 = 2
Case 8: col2 = 8
Case 12: col2 = 14
Case 16: col2 = 20
'Sh1.Cells(rw + 2, 13).Resize(Int(Target.Count / 3), 3).Interior.ColorIndex = j
End Select
InsideColors Sh1, rw, col2, CellCnt, ar()

Set Sh1 = Nothing
End Sub
Private Sub InsideColors(sh As Worksheet, _
rw As Long, _
col As Integer, _
cnt As Integer, _
ar As Variant)
'sh[シート],rw[行], col[列],cnt[セル個数],iColor[色指数]
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim k As Integer
If cnt Mod 5 > 0 Then '範囲行数
i = (cnt + 5 - (cnt Mod 5)) / 5
Else
i = cnt / 5
End If
rw = Int((rw - 1) / 5) + 1 '行再設定
j = ((rw - 1) Mod 5) + 1 '列設定
For n = j To cnt
sh.Cells(rw + 2, col).Resize(i, 5).Cells(n).Interior.ColorIndex = ar(k)
k = k + 1
Next n
End Sub

毎回他の人を頼ってしまい、申し訳ないのですがお願いします。
また、前回分からなかったので1～5を指定するときに5回同じカラー番号を書いたのですがこちらも良かったら手直し方法を教えていただければ助かります。

宜しくお願いします。

回答No.5

lul · ベストアンサー

こんにちは。
さっきのソースを少し変更しました。
これで対応できると思います。
Private Sub Worksheet_Change(ByVal Target As Range)
Const MaxCol As Integer = 28
Dim intUpdateColumn As Integer
Dim intColor As Integer
Dim c As Variant
Dim i As Integer, col As Integer
Dim Sh1 As Worksheet
Set Sh1 = Worksheets("小児科Dr")
col = Target.Cells(1).Column
If col Mod 6 <> 4 Or col > MaxCol Then Exit Sub '制限された列
For Each c In Target
col = c.Column
If c.Value <> "" And IsNumeric(c.Value) Then
Select Case c.Offset(0, 1)
Case Is >= 0.91: intColor = 5
Case Is >= 0.81: intColor = 3
Case Else: intColor = 2
End Select
intUpdateColumn = Int((col - 4) / 6) * 2 + 2
Sh1.Cells(c.Row, intUpdateColumn).Interior.ColorIndex = intColor
End If
Next c
Set Sh1 = Nothing
End Sub
変更箇所はピックアップするセル列の追加と反映先のセル列の計算です。
これでご希望されている処理は出来そうですか？

お礼

ありがとうございます！！
完璧に思い通りの動きをしてくれました。

こんな形でしかお礼が出来ないのが残念です。。

本当にありがとうございました☆

回答No.4

lul

こんにちは！
ご説明頂いた事を実現するなら以下のコードのみで出来ると思います。
Private Sub Worksheet_Change(ByVal Target As Range)
Const intUpdateColumn As Integer = 2
Dim intColor As Integer
Dim c As Variant
Dim Sh1 As Worksheet
Set Sh1 = Worksheets("小児科Dr")
If Not Target.Cells(1).Column = 4 Then Exit Sub '制限された列
For Each c In Target
If c.Value <> "" And IsNumeric(c.Value) Then
Select Case c.Offset(0, 1)
Case Is >= 0.91: intColor = 5
Case Is >= 0.81: intColor = 3
Case Else: intColor = 2
End Select
Sh1.Cells(c.Row, intUpdateColumn).Interior.ColorIndex = intColor
End If
Next c
Set Sh1 = Nothing
End Sub
進捗を記載するシートのマクロとして使用して下さい。
上記では、Ｄ列が変更された場合にＥ列の値を見て「小児科Dr」というシートのＢ列の対応する行の色を編集しています。
こんな感じで良かったでしょうか？

補足

ありがとうございます。
キレイに色が一段ずつ付きました！！

ですが、本当に何度も申し訳ないのですが、
ソースを書いてあるシートにはA～E（A列：番号、B列：氏名、C列：目標、D列：進捗、E列：進捗率<D/C>）の表があり、F列は空欄でまた
G～K列までA～Eと同じ表があります。（エリアごとの表になっているため、同じ表が横に5つあります）

色を表すシートも同じようにB列・D列・F列と一つ飛ばしに表が5つありソースを書いてあるシートのE列・K列・・・との表の5つ目をそれぞれ行を見てセルの色が塗られるといったフォーマットなのです。。。

こちらの説明不足、また説明下手で何度もお手数をおかけしてしまい申し訳ございません。

現在のソースの中で同じように横に連なる表に色をつけるためには
どのようなソースを書き足すのでしょうか？
ファイルを添付できれば分かりやすいのですが・・・。

分かりづらい説明ですみません。。

～色を付けるシート＆セル～
A列　B列　C列　D列　E列
□　　　　　　□　　　　　　□
□　　　　　　□　　　　　　□　　　　　　　
□　　　　　　□　　　　　　□　　　　　　　
□　　　　　　□　　　　　　□

～ソースが書いてあるシート～
A列　B列　C列　D列　E列　F列　G列　H列　I列　J列　K列　
No.　氏名 目標 進捗 　 %　　　　　　No.　氏名 目標 進捗 %　
No.　氏名 目標 進捗 　 %　　　　　　No.　氏名 目標 進捗 %
No.　氏名 目標 進捗 　 %　　　　　　No.　氏名 目標 進捗 %

上記それぞれのシートでE列（ソースのシート）＝B列（色のシート）
K列（ソースのシート）＝D列（色のシート）という感じにしたいです。

回答No.3

lul

こんにちは、まずご質問の件ですが
iColors = Array(16, 16, 16, 16, 16, 53, 53, 53, 53, 53, 54, 54, 54, 54, 54)
これに関しましては不要です、あっても別に害はありませんが…(使用していないので)
次に
If Not (col = 4 Or col = 8 Or col = 12 Or col = 16) Then Exit Sub
これに関しましては、変更されたセルの列が４列目、８列目、１２列目もしくは１６列目でなければ処理はしないという事ですね、iguyuk0512様の方でそういった仕様にされていないのであれば削除して頂いても問題ないかと思います。
InsideColorsプロシージャの方でも色々セルの位置を計算しておられるようですので希望されている箇所へきちんと反映されているかどうかは仕様を知らない為分かりませんが、こちらでテストしてみた所色付けは出来ているようでした。
詳細にやりたい事が分かればすぐに回答できるんですがこういった場では難しいですね(^＾;

補足

何度もご回答ありがとうございます。

他のファイルで試してみたところ、確かに色は変わりました。

ソースを書いているシートですが、C列に目標、D列に進捗、E列にD/Cの計算式を入れています。
進捗を入れるとE列の進捗率が変わるといったフォームにしていますが
計算式のせいで色が変わらないのでしょうか？

直接入力でなければ変わらないものですか？

また、こちらの説明不足で申し訳ないのですが
ソースを書いているシートのE3へ入力すると、別シート上のB3の色が変わり、E4へ入力するとB4が変わるようにしたいのですが
現在のソースですとE4に入力してもB3が変わってしまいます。

E列の何行目に入力しても色が変わるのはB3なのですが
E3＝B3、E4＝B4、E5＝B5と色が変わるにはどこを書き換えれば
良いのでしょうか？

大変申し訳ないのですが、宜しくお願いします。。

回答No.2

lul

やはり勘違いしていましたね…失礼しました。
で、ご要望の件ですが、プロシージャ「Worksheet_Change」の
For Each c In Target
～
Next c
の部分を以下のように修正して頂ければ実現できるかと思われます。
For Each c In Target
If c.Value <> "" Then
If IsNumeric(c.Value) Then
Select Case c.Value
Case Is >= 0.91: ar(k) = 5
Case Is >= 0.81: ar(k) = 3
Case Else: ar(k) = 2
End Select
k = k + 1
End If
End If
Next c
まだ回答が完全でなければまた仰って下さい。

補足

早急なご回答ありがとうございます。
作業を会社でやっているので、確認が出来ずご返事遅くなってしまい、申し訳ございません。。。

やってみたのですが、特に反応がなく・・・デバックも出なかったので何がおかしいのか自分なりに考えてみたのですが

If Not (col = 4 Or col = 8 Or col = 12 Or col = 16) Then Exit Sub
iColors = Array(16, 16, 16, 16, 16, 53, 53, 53, 53, 53, 54, 54, 54, 54, 54)

というソースは残しておいていいものでしょうか？
こちらでもカラーの指定をしてるのでダブっているのかなとちょっと思ったのですが。
素人判断なので分かりませんが、何か策があればまたご回答いただけると幸いです。

回答No.1

lul

こんにちは、前回というのがどのような話だったのか分かりませんが
ソースを見た感じだと、「Private Sub Worksheet_Change」中の
iColors = Array(16, 16, 16, 16, 16, 53, 53, 53, 53, 53, 54, 54, 54, 54, 54)
という箇所を以下のように書き換えればご希望通りになると思います。
iColors = Array(2,2,2,2,2,2,2,2,3,5,5,5,5,5,5)
これで出来ませんか？もし質問を勘違いしていましたら言って下さい^^;

補足

ご回答ありがとうございます。
前回は下記のような質問をしました。
http://oshiete1.goo.ne.jp/qa3686374.html

恐らく％を使うと小数点での扱いになりますが
現時点のソースでは1以上でのソースではないかと思います。

Case Is >= 0.91: myColor = 38
Case Is >= 0.81: myColor = 37
上記のような書き方をすれば良いのだと単純に思うのですが
私が持っているソースを上記のようにする書き方が分かりません。。

お分かりになりますか？