Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5895 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【48299】塗りつぶし24色 りえ 07/4/12(木) 10:15 質問[未読]
【48302】Re:塗りつぶし24色 Jaka 07/4/12(木) 10:55 発言[未読]
【48306】Re:塗りつぶし24色 りえ 07/4/12(木) 11:24 発言[未読]
【48307】Re:塗りつぶし24色 Jaka 07/4/12(木) 13:09 発言[未読]
【48308】Re:塗りつぶし24色 Jaka 07/4/12(木) 14:46 発言[未読]
【48314】Re:塗りつぶし24色 りえ 07/4/12(木) 16:34 発言[未読]
【48316】Re:塗りつぶし24色 Jaka 07/4/12(木) 17:07 発言[未読]
【48317】Re:塗りつぶし24色 りえ 07/4/12(木) 17:21 発言[未読]
【48319】Re:塗りつぶし24色 Jaka 07/4/12(木) 17:31 発言[未読]
【48338】Re:塗りつぶし24色 松村 07/4/13(金) 10:49 発言[未読]
【48339】Re:塗りつぶし24色 りえ 07/4/13(金) 10:52 お礼[未読]
【48299】塗りつぶし24色
質問  りえ  - 07/4/12(木) 10:15 -
引用なし
パスワード
   １と入力すれば、１と入力されているセルが赤それを、２４色使い
行いたい。
行ってみた、ほぼ、完成ですが・・・

調べたが、分からないので教えてください。

FORループ★モジュールで全てのセルをチェックしないと、行か列が増えた時の対応
規定外の数字はELSEを使う。
とのことですが、使い方をおしえてください。


Sub 数値セル塗チェック()
　　Dim RowPos As Integer
　　Dim ColPos As Integer
　　Dim Num As Integer
　　　
　　Set WS = Worksheets("Sheet1")
　　
　　'セルの指定
　　RowPos = 1
　　ColPos = 1
　　Do
　　　　If WS.Cells(RowPos, ColPos) = "" Then
　　　　　　Exit Do
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 1 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 0, 0)
　　　　End If
　　　　If Num = 2 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 0, 0)
　　　　End If
　　　　If Num = 3 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 255, 0)
　　　　End If
　　　　If Num = 4 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 0, 255)
　　　　End If
　　　　If Num = 5 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 100, 90)
　　　　End If
　　　　If Num = 6 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 0, 180)
　　　　End If
　　　　If Num = 7 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(100, 25, 100)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 8 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 25, 100)
　　　　End If
　　　　If Num = 9 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 25, 0)
　　　　End If
　　　　If Num = 10 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 255, 100)
　　　　End If
　　　　If Num = 11 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(230, 25, 100)
　　　　End If
　　　　If Num = 12 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(29, 71, 29)
　　　　End If
　　　　If Num = 13 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 71, 29)
　　　　End If
　　　　If Num = 14 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 71, 29)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 15 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(203, 97, 17)
　　　　End If
　　　　If Num = 16 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(117, 107, 103)
　　　　End If
　　　　If Num = 17 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(140, 4, 216)
　　　　End If
　　　　If Num = 18 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(186, 132, 168)
　　　　End If
　　　　If Num = 19 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(248, 255, 159)
　　　　End If
　　　　If Num = 20 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(168, 242, 246)
　　　　End If
　　　　If Num = 21 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(247, 209, 167)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 22 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(205, 113, 133)
　　　　End If
　　　　If Num = 23 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(81, 48, 45)
　　　　End If
　　　　If Num = 24 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(252, 252, 28)
　　　　End If
　　　　RowPos = RowPos + 1
　　Loop While Num > -1
　　
　　'セルの指定
　　RowPos = 1
　　ColPos = 2
　　Do
　　　　 If WS.Cells(RowPos, ColPos) = "" Then
　　　　　　Exit Do
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 1 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 0, 0)
　　　　End If
　　　　If Num = 2 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 0, 0)
　　　　End If
　　　　If Num = 3 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 255, 0)
　　　　End If
　　　　If Num = 4 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 0, 255)
　　　　End If
　　　　If Num = 5 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 100, 90)
　　　　End If
　　　　If Num = 6 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 0, 180)
　　　　End If
　　　　If Num = 7 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(100, 25, 100)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 8 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 25, 100)
　　　　End If
　　　　If Num = 9 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 25, 0)
　　　　End If
　　　　If Num = 10 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 255, 100)
　　　　End If
　　　　If Num = 11 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(230, 25, 100)
　　　　End If
　　　　If Num = 12 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(29, 71, 29)
　　　　End If
　　　　If Num = 13 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 71, 29)
　　　　End If
　　　　If Num = 14 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 71, 29)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 15 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(203, 97, 17)
　　　　End If
　　　　If Num = 16 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(117, 107, 103)
　　　　End If
　　　　If Num = 17 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(140, 4, 216)
　　　　End If
　　　　If Num = 18 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(186, 132, 168)
　　　　End If
　　　　If Num = 19 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(248, 255, 159)
　　　　End If
　　　　If Num = 20 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(168, 242, 246)
　　　　End If
　　　　If Num = 21 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(247, 209, 167)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 22 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(205, 113, 133)
　　　　End If
　　　　If Num = 23 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(81, 48, 45)
　　　　End If
　　　　If Num = 24 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(252, 252, 28)
　　　　End If
　　　　RowPos = RowPos + 1
　　Loop While Num > -1
　　
　　'セルの指定
　　RowPos = 1
　　ColPos = 3
　　Do
　　If WS.Cells(RowPos, ColPos) = "" Then
　　　　　　Exit Do
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 1 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 0, 0)
　　　　End If
　　　　If Num = 2 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 0, 0)
　　　　End If
　　　　If Num = 3 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 255, 0)
　　　　End If
　　　　If Num = 4 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 0, 255)
　　　　End If
　　　　If Num = 5 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 100, 90)
　　　　End If
　　　　If Num = 6 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 0, 180)
　　　　End If
　　　　If Num = 7 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(100, 25, 100)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 8 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 25, 100)
　　　　End If
　　　　If Num = 9 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 25, 0)
　　　　End If
　　　　If Num = 10 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 255, 100)
　　　　End If
　　　　If Num = 11 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(230, 25, 100)
　　　　End If
　　　　If Num = 12 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(29, 71, 29)
　　　　End If
　　　　If Num = 13 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(255, 71, 29)
　　　　End If
　　　　If Num = 14 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(0, 71, 29)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 15 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(203, 97, 17)
　　　　End If
　　　　If Num = 16 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(117, 107, 103)
　　　　End If
　　　　If Num = 17 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(140, 4, 216)
　　　　End If
　　　　If Num = 18 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(186, 132, 168)
　　　　End If
　　　　If Num = 19 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(248, 255, 159)
　　　　End If
　　　　If Num = 20 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(168, 242, 246)
　　　　End If
　　　　If Num = 21 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(247, 209, 167)
　　　　End If
　　　　Num = WS.Cells(RowPos, ColPos)
　　　　If Num = 22 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(205, 113, 133)
　　　　End If
　　　　If Num = 23 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(81, 48, 45)
　　　　End If
　　　　If Num = 24 Then
　　　　　　WS.Cells(RowPos, ColPos).Interior.Color = RGB(252, 252, 28)
　　　　End If
　　　　RowPos = RowPos + 1
　　Loop While Num > -1
【48302】Re:塗りつぶし24色
発言  Jaka  - 07/4/12(木) 10:55 -
引用なし
パスワード
   　　　　　　↓色の数と合わせること。
Dim TB(1 To 16, 1 To 3) As Long
TB(1, 1) = 0: TB(1, 2) = 0: TB(1, 3) = 0
TB(2, 1) = 255: TB(2, 2) = 0: TB(2, 3) = 0
TB(3, 1) = 0: TB(3, 2) = 255: TB(3, 3) = 0
TB(4, 1) = 0: TB(4, 2) = 0: TB(4, 3) = 255
TB(5, 1) = 0: TB(5, 2) = 100: TB(5, 3) = 90
TB(6, 1) = 255: TB(6, 2) = 0: TB(6, 3) = 180
TB(7, 1) = 100: TB(7, 2) = 25: TB(7, 3) = 100
TB(8, 1) = 0: TB(8, 2) = 25: TB(8, 3) = 100
TB(9, 1) = 0: TB(9, 2) = 25: TB(9, 3) = 0
TB(10, 1) = 0: TB(10, 2) = 255: TB(10, 3) = 100
TB(11, 1) = 230: TB(11, 2) = 25: TB(11, 3) = 100
TB(12, 1) = 29: TB(12, 2) = 71: TB(12, 3) = 29
TB(13, 1) = 255: TB(13, 2) = 71: TB(13, 3) = 29
TB(14, 1) = 0: TB(14, 2) = 71: TB(14, 3) = 29
TB(15, 1) = 203: TB(15, 2) = 97: TB(15, 3) = 17
TB(16, 1) = 117: TB(16, 2) = 1071: TB(16, 3) = 103
　　　・
　　　・
　　　略（手抜き）配列にするとわかりづらいですね。すみません。


For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　 For ii = 1 To Cells(i, 256).End(xlToRight).Column
　　　If Cells(i, ii) <> "" Then
　　　　 Num = Cells(i, ii)
　　　　 Cells(i, ii).Interior.Color = RGB(TB(Num, 1), TB(Num, 2), TB(Num, 3))
　　　　 Cells(i, ii).Select
　　　End If
　 Next
Next
【48306】Re:塗りつぶし24色
発言  りえ  - 07/4/12(木) 11:24 -
引用なし
パスワード
   ▼Jaka さん：
ありがとうございます
ＶＢＡ初心者でごめんなさい
わかりません

私が作成をしたコードですと、行列が追加したときに
コード追加をしていかないといけないので
他の方法があるかと・・・
思ったのですが
どのように変更したらよいですか？
かき込みしてくださったのを何処にいれるのですか？
【48307】Re:塗りつぶし24色
発言  Jaka  - 07/4/12(木) 13:09 -
引用なし
パスワード
   >どのように変更したらよいですか？
>かき込みしてくださったのを何処にいれるのですか？
変更とかどこに入れるとかでなく、全部入れ替えになります。
（手抜きで省略してますが）

間違いがありましたので、変更してください。
　 For ii = 1 To Cells(i, 256).End(xlToRight).Column
　　　　　　　　　　　　　　　　　　　　　↓
　 For ii = 1 To Cells(i, 256).End(xlToLeft).Column

Forを使ったときのポイントは、これら↓が解らないと厳しいです。

>For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
>　 For ii = 1 To Cells(i, 256).End(xlToRight).Column

Ａ列１番下の行から、上に向かって、最初に見つかった空白で無いセルの行
Cells(Rows.Count, 1).End(xlUp).Row

i行２５６列から、左に向かって最初に見つかった空白でない列
　 For ii = 1 To Cells(i, 256).End(xlToLeft).Column

セルA65536を選択した状態で、Ctrl + ↑ を押したのと同じです。
セルIV1（行は変動してますが）を選択した状態で、Ctrl + ← を押したのと同じです。
【48308】Re:塗りつぶし24色
発言  Jaka  - 07/4/12(木) 14:46 -
引用なし
パスワード
   なんか理解不能っぽいのでＵＰしても意味が無いかもしれないけれど、
全部書いてみた。

Dim TB(1 To 24, 1 To 3) As Long
Dim i As Long, ii As Long
TB(1, 1) = 0: TB(1, 2) = 0: TB(1, 3) = 0
TB(2, 1) = 255: TB(2, 2) = 0: TB(2, 3) = 0
TB(3, 1) = 0: TB(3, 2) = 255: TB(3, 3) = 0
TB(4, 1) = 0: TB(4, 2) = 0: TB(4, 3) = 255
TB(5, 1) = 0: TB(5, 2) = 100: TB(5, 3) = 90
TB(6, 1) = 255: TB(6, 2) = 0: TB(6, 3) = 180
TB(7, 1) = 100: TB(7, 2) = 25: TB(7, 3) = 100
TB(8, 1) = 0: TB(8, 2) = 25: TB(8, 3) = 100
TB(9, 1) = 0: TB(9, 2) = 25: TB(9, 3) = 0
TB(10, 1) = 0: TB(10, 2) = 255: TB(10, 3) = 100
TB(11, 1) = 230: TB(11, 2) = 25: TB(11, 3) = 100
TB(12, 1) = 29: TB(12, 2) = 71: TB(12, 3) = 29
TB(13, 1) = 255: TB(13, 2) = 71: TB(13, 3) = 29
TB(14, 1) = 0: TB(14, 2) = 71: TB(14, 3) = 29
TB(15, 1) = 203: TB(15, 2) = 97: TB(15, 3) = 17
TB(16, 1) = 117: TB(16, 2) = 1071: TB(16, 3) = 103
TB(17, 1) = 140: TB(17, 2) = 4: TB(17, 3) = 216
TB(18, 1) = 186: TB(18, 2) = 132: TB(18, 3) = 168
TB(19, 1) = 248: TB(19, 2) = 255: TB(19, 3) = 159
TB(20, 1) = 168: TB(20, 2) = 242: TB(20, 3) = 246
TB(21, 1) = 247: TB(21, 2) = 209: TB(21, 3) = 167
TB(22, 1) = 205: TB(22, 2) = 113: TB(22, 3) = 133
TB(23, 1) = 81: TB(23, 2) = 48: TB(23, 3) = 45
TB(24, 1) = 252: TB(24, 2) = 252: TB(24, 3) = 28

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　 For ii = 1 To Cells(i, 256).End(xlToRight).Column
　　　If Cells(i, ii).Value <> "" Then
　　　　 If Cells(i, ii).Value > 0 And Cells(i, ii).Value <= 24 Then
　　　　　　Num = Cells(i, ii)
　　　　　　Cells(i, ii).Interior.Color = RGB(TB(Num, 1), TB(Num, 2), TB(Num, 3))
　　　　 End If
　　　Else
　　　　 'Exit For　'途中の空白のところで終わらせたいなら（列方向に対して）
　　　End If
　 Next
Next
【48314】Re:塗りつぶし24色
発言  りえ  - 07/4/12(木) 16:34 -
引用なし
パスワード
   ▼Jaka さん：
>なんか理解不能っぽいのでＵＰしても意味が無いかもしれないけれど、

お返事がおそくなりました
すいません
コピペしたのですが、コンパイルエラーでました

すいません　VBAまったくわからなくて・・・
申し訳ないです。
【48316】Re:塗りつぶし24色
発言  Jaka  - 07/4/12(木) 17:07 -
引用なし
パスワード
   ▼りえ さん：
>コピペしたのですが、コンパイルエラーでました
Sub ○○()

End Sub
の中に入れてください。

>VBAまったくわからなくて・・・
提示されたコードはどうしたんですか？
私は、良く解らないから使いたくないＲＧＢカラー使っていたけど...。
【48317】Re:塗りつぶし24色
発言  りえ  - 07/4/12(木) 17:21 -
引用なし
パスワード
   ▼Jaka さん：
if関数のように、わからないなりに、調べて一個ずつすると
出来たので意味は余りしっかり理解できていないのです、

Subの中とは？
ほんとすいません
【48319】Re:塗りつぶし24色
発言  Jaka  - 07/4/12(木) 17:31 -
引用なし
パスワード
   ▼りえ さん：
>Subの中とは？

Sub ○○()
　　　　　←　ここ
End Sub
【48338】Re:塗りつぶし24色
発言  松村  - 07/4/13(金) 10:49 -
引用なし
パスワード
   ▼Jaka さん：
>▼りえ さん：
>>Subの中とは？
>
>Sub ○○()
>　　　　　←　ここ
>End Sub

がんばってください。
【48339】Re:塗りつぶし24色
お礼  りえ  - 07/4/13(金) 10:52 -
引用なし
パスワード
   >▼Jaka さん：

ありがとうございました
できました
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5895 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free