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回同じカラー番号を書いたのですがこちらも良かったら手直し方法を教えていただければ助かります。
宜しくお願いします。
お礼
早速有り難うございました。 配列を使えばと思っていたのですが、 その使い方が今ひとつ浮かびませんでした。 教えていただいた例を調べてみます。 どちらの例もアトから見てよく分かりますので、良いと思いますが、 debug.print array(1, 1, 3, 4, 5, 4, 5, 8, 9)(m - 1) の方が簡単みたいですね。 とにかく調べて使いこなせるようにしたいと思います。 お世話になりました。