セルに入力する値によって、重複した場合にセルの色が変化するようにVBAで記述しましたが、設定した行数が多すぎて、コンパイルエラー「プロシージャが大きすぎます」とのエラーが出ます。小さく記述するにはどの様に書いたらよいでしょうか?ご指導お願いいたします。
記述したVBAは下記とおりです。約35行ほどでエラーです。
Private Sub Worksheet_Change(ByVal Target As Range)
Set myRng = Range("B2") '2行目の設定
For Each c In myRng
If c.Value = "" Then
c.Interior.ColorIndex = 2 'B2が空白ならばセルの色を白色
ElseIf c.Value = Range("I2") Then
c.Interior.ColorIndex = 3 'B2=I2ならばセルの色を赤色
ElseIf c.Value = Range("J2") Then
c.Interior.ColorIndex = 6 'B2=J2ならばセルの色を黄色
ElseIf c.Value = Range("K2") Then
c.Interior.ColorIndex = 6 'B2=K2ならばセルの色を黄色
ElseIf c.Value = Range("L2") Then
c.Interior.ColorIndex = 8 'B2=L2ならばセルの色を青色
ElseIf c.Value = Range("M2") Then
c.Interior.ColorIndex = 8 'B2=M2ならばセルの色を青色
Else
c.Interior.ColorIndex = xINone
End If
Next c
Set myRng = Range("C2") '2行目の設定
For Each c In myRng
If c.Value = "" Then
c.Interior.ColorIndex = 2 'C2が空白ならばセルの色を白色
ElseIf c.Value = Range("I2") Then
c.Interior.ColorIndex = 6 'C2=I2ならばセルの色を黄色
ElseIf c.Value = Range("J2") Then
c.Interior.ColorIndex = 6 'C2=J2ならばセルの色を黄色
ElseIf c.Value = Range("K2") Then
c.Interior.ColorIndex = 6 'C2=K2ならばセルの色を黄色
ElseIf c.Value = Range("L2") Then
c.Interior.ColorIndex = 8 'C2=L2ならばセルの色を青色
ElseIf c.Value = Range("M2") Then
c.Interior.ColorIndex = 8 'C2=M2ならばセルの色を青色
Else
c.Interior.ColorIndex = xINone
End If
Next c
Set myRng = Range("D2") '2行目の設定
For Each c In myRng
If c.Value = "" Then
c.Interior.ColorIndex = 2 'D2が空白ならばセルの色を白色
ElseIf c.Value = Range("I2") Then
c.Interior.ColorIndex = 6 'D2=I2ならばセルの色を黄色
ElseIf c.Value = Range("J2") Then
c.Interior.ColorIndex = 6 'D2=J2ならばセルの色を黄色
ElseIf c.Value = Range("K2") Then
c.Interior.ColorIndex = 6 'D2=K2ならばセルの色を黄色
ElseIf c.Value = Range("L2") Then
c.Interior.ColorIndex = 8 'D2=L2ならばセルの色を青色
ElseIf c.Value = Range("M2") Then
c.Interior.ColorIndex = 8 'D2=M2ならばセルの色を青色
Else
c.Interior.ColorIndex = xINone
End If
Next c
・
・
End Sub
No.10ベストアンサー
- 回答日時:
こんにちは。
単に、パターンを二つ用意すればよいだけです。
2つのパターンが、3つでも同じことです。
>入力は2行目から100行ほど使用します。
現在は、この制限は設けていません。
必要なら、
j = Target.Row の下に、
If j < 2 Or j >100 Then Exit Sub
を付けてください。
'------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Variant
Dim j As Long
Dim k As Variant
Dim Ar1 As Variant
Dim Ar2 As Variant
If Target.Count > 1 Then Exit Sub '複数セルは除外
j = Target.Row
Ar1 = Array(3, 6, 6, 8, 8) 'パターン1
Ar2 = Array(6, 6, 6, 8, 8) 'パターン2
For Each k In Array(2, 3, 4) 'B,C,D
If Cells(j, k).Value = "" Then
Cells(j, k).Interior.ColorIndex = 2
Else
i = Application.Match(Cells(j, k).Value, Range(Cells(j, 9), Cells(j, 13)), 0) 'I-M
If Not IsError(i) Then
If k = 2 Then
Cells(j, k).Interior.ColorIndex = Ar1(i - 1)
Else
Cells(j, k).Interior.ColorIndex = Ar2(i - 1)
End If
Else
Cells(j, k).Interior.ColorIndex = xlNone
End If
End If
Next
End Sub
No.9
- 回答日時:
こんばんは。
最初から、条件付き書式のマクロ版と分かれば、そのように作りましたが、あまり例のないパターンだと思います。本来は、条件付き書式のマクロ版は、Change イベントでよかったのか、OnEntry を使うのか、はっきりしません。OnEntryの方が安定しているような気がしますが、どちらでも大差はないとは思います。それと、Interior.ColorIndex = 2 は、背景とか文字の色とかに依存されるので、これが発生すると枠線が消えてしまいます。
>B=I赤 B=J黄 B=K黄 B=L青 B=M青
>C=I黄 C=J黄 C=K黄 C=L青 C=M青
>D=I黄 D=J黄 D=K黄 D=L青 D=M青
C=I黄, D=I黄 は、赤ではないでしょうか。もし、そうなら以下のようになるはずです。
----------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Variant
Dim j As Long
Dim k As Variant
Dim Ar As Variant
If Target.Count > 1 Then Exit Sub '複数セルは除外
j = Target.Row
Ar = Array(3, 6, 6, 8, 8) '色番号
For Each k In Array(2, 3, 4) 'B,C,D
If Cells(j, k).Value = "" Then
Cells(j, k).Interior.ColorIndex = 2
Else
i = Application.Match(Cells(j, k).Value, Range(Cells(j, 9), Cells(j, 13)), 0) 'I-M
If Not IsError(i) Then
Cells(j, k).Interior.ColorIndex = Ar(i - 1)
Else
Cells(j, k).Interior.ColorIndex = xlNone
End If
End If
Next
End Sub
この回答への補足
追記で回答ありがとうございます。
複雑な質問で申しわけありません。
C=I D=I は、赤ではなく、黄色になればありがたいのですが、自分では知識不足で難航しています。
No.8
- 回答日時:
#7です。
>今回は条件書式でクリアーできましたが、条件書式で対処できない場合に、
>VBAで記述する方法をご教授願えれば
条件付き書式でやらないと処理がややこしくなるので提案した次第です。
よって更に条件を複雑化される場合では、私には追いつけません。
ごめんなさい。
No.7
- 回答日時:
#6です。
>セルの色の条件がI列からM列まで5つの条件で変化するので、
>条件付き書式では3つまでしか設定できませんので無理でした。
B列については、
・I列と同じなら、赤色 =B2=I2
・J列又はK列と同じなら、黄色 =OR(B2=J2,B2=K2)
・L列又はM列と同じなら、青色 =OR(B2=L2,B2=M2)
C・D列については、
・I列又はJ列又はK列と同じなら、黄色 =OR(C2=$I2,C2=$J2,C2=$K2)
・L列又はM列と同じなら、青色 =OR(C2=$I2,C2=$M2)
をつける。(それ以外の場合は色はつかないはず)
と考えれば条件は3つ以内で収まるのですが、それでもダメだったのでしょうか?
参考URL:
3つの条件で書式を変える >数式で条件を設定する場合
参照願います。
参考URL:http://www.eurus.dti.ne.jp/~yoneyama/Excel/jyo-s …
できました! ありがとうございます。
条件書式は3つまでと思っていましたので、この様な方法があるとは考えもつきませんでした。ひとつ賢くなりました。
ついでと言っては何ですが、今回は条件書式でクリアーできましたが、条件書式で対処できない場合に、VBAで記述する方法をご教授願えれば大変ありがたいのですが、宜しくお願いいたします。
No.6
- 回答日時:
#4です。
>逆からI2に5を入力してB2に5を入力してもB2セルが赤色になると便利なのですが
I列が変化した時にB列も変化させたいならば、C・D列はその時どうなるの?
>また、入力したセルを複数選択してDeleteで消去するとエラーが出てしまいました
データ行数がどの位なのかわかりませんが、条件付き書式ではできなかったのでしょうか。
この回答への補足
知識不足で申しわけありません
各B列・C列・D列の色の変化に対する条件は、個々に独立していますので、C・D列に変化はありません。
セルの色の変化は下記のとおりです
B=I赤 B=J黄 B=K黄 B=L青 B=M青
C=I黄 C=J黄 C=K黄 C=L青 C=M青
D=I黄 D=J黄 D=K黄 D=L青 D=M青
セルの色の条件がI列からM列まで5つの条件で変化するので、条件付き書式では3つまでしか設定できませんので無理でした。
No.5
- 回答日時:
こんばんは。
少しやりたいことを解説をしてもらわないと、良く分からないです。
色を変えるのは、入力したセルのはずです。それが、Target セルです。いくらループしても、一回きりなら同じなのではありませんか?
例えば、こんな風には出来ますが、コードだけでは、意味が取り違えているかもしれません。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub '複数セルは除外
If Target.Row <> 2 Then Exit Sub '2行目
If Target.Column < 2 Or Target.Column > 8 Then Exit Sub 'B~Hまで(排他的設定)
With Target
Select Case True
Case .Value = "": .Interior.ColorIndex = 2 'B2が空白ならばセルの色を白色
Case .Value = Range("I2").Value: .Interior.ColorIndex = 3 '赤色
Case .Value = Range("J2").Value: .Interior.ColorIndex = 6 '黄色
Case .Value = Range("K2").Value: .Interior.ColorIndex = 6 '黄色
Case .Value = Range("L2").Value: .Interior.ColorIndex = 8 '青色
Case .Value = Range("M2").Value: .Interior.ColorIndex = 8 '青色
Case Else: .Interior.ColorIndex = xlNone
End Select
End With
End Sub
この回答への補足
分かりづらい質問で申しわけありません。
補足しますと、B列からD列とI列からM列を使用します。
セルの色が値によって変わるのは、B列からD列です。
例えばB2に5を入力してI2に5を入力するとB2セルが赤色になり
逆からI2に5を入力してB2に5を入力してもB2セルが赤色になります
入力は2行目から100行ほど使用します。
セルの色の変化は下記のとおりです
B=I赤 B=J黄 B=K黄 B=L青 B=M青
C=I黄 C=J黄 C=K黄 C=L青 C=M青
D=I黄 D=J黄 D=K黄 D=L青 D=M青
No.4
- 回答日時:
#1です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Variant
With Target
If .Row < 2 Then Exit Sub '1行目は除外
If .Column > 8 Then Exit Sub 'A~H列が対象
If .Value = "" Then .Interior.ColorIndex = 2: Exit Sub '空白ならばセルの色を白色
On Error Resume Next
i = Application.Match(.Value, _
Range(Range("I" & .Row), Range("M" & .Row)), 0)
If IsError(i) Then i = 0
On Error GoTo 0
Select Case i
Case 1
.Interior.ColorIndex = 3 'I列と同じなら赤色
Case 2 To 3
.Interior.ColorIndex = 6 'J・K列と同じなら黄色
Case 4 To 5
.Interior.ColorIndex = 8 'L・M列と同じなら青色
Case Else
.Interior.ColorIndex = xlNone '一致した列がなければ色なし
End Select
End With
End Sub
勘違いでしたらごめんなさい。
この回答への補足
RowとGoToを使用するのですね。
逆からI2に5を入力してB2に5を入力してもB2セルが赤色になると便利なのですが
また、入力したセルを複数選択してDeleteで消去するとエラーが出てしまいました
どうしたら良いでしょうか?
No.3
- 回答日時:
ElseIf c.Value = Range("I2") Then
c.Interior.ColorIndex = 3 'B2=I2ならばセルの色を赤色
ElseIf c.Value = Range("I2") Then
c.Interior.ColorIndex = 6 'C2=I2ならばセルの色を黄色
ElseIf c.Value = Range("I2") Then
c.Interior.ColorIndex = 6 'D2=I2ならばセルの色を黄色
上記、3か所提示されたセルで、B2のみ、ColorIndex = 3となっていますが間違いないですか?
Set myRng = Range("B2") '2行目の設定
For Each c In myRng
・
・
Next C
上記、myRngがRange("B2")のみの単独セルで、For Eachする必要はないですね。
やるなら
Set myRng = Range("B2:H2")
For Each c In myRng
If c.Value = "" Then
c.Interior.ColorIndex = 2 'Cが空白ならばセルの色を白色
ElseIf c.Value = Range("I2") Then
If c.Address = "B2" Then 'B2=I2ならばセルの色を赤色
c.Interior.ColorIndex = 3
Else 'B2以外でI2ならばセルの色を赤色
c.Interior.ColorIndex = 6
End If
ElseIf c.Value = Range("J2") Then
c.Interior.ColorIndex = 6 'C=J2ならばセルの色を黄色
ElseIf c.Value = Range("K2") Then
c.Interior.ColorIndex = 6 'C=K2ならばセルの色を黄色
ElseIf c.Value = Range("L2") Then
c.Interior.ColorIndex = 8 'C=L2ならばセルの色を青色
ElseIf c.Value = Range("M2") Then
c.Interior.ColorIndex = 8 'C=M2ならばセルの色を青色
Else
c.Interior.ColorIndex = xINone
End If
Next c
この回答への補足
If~ElseIfステートメントを使用しても同様な作業ができるのですね
3行目以降もセルの色の変化が必要ですのでお知恵をお貸し下さい
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBA ダブルクリックしたら色反転を指定したセルのみにしたい 2 2022/04/06 12:52
- Visual Basic(VBA) excel2021で実行できないマクロ。どこを直したらいいのか 2 2022/03/28 03:40
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
- Visual Basic(VBA) Worksheet_Change 4 2023/03/12 21:54
- Visual Basic(VBA) C3とC4のセルに、Visual basicで実行した時入力した値をC3に表示させ、その後に、C3に 1 2023/07/14 09:43
- Visual Basic(VBA) [Excel VBA] このコードでは行の挿入や行の消去をすると13のエラーが出てしまう。 3 2022/12/09 00:29
- Excel(エクセル) B列に文字がはいったらA列に数字が入るマクロードを完成させたい 4 2023/04/21 01:58
- Visual Basic(VBA) 動きっぱなしです。止め方とプロシージャの間違いを教えて下さい! 5 2022/08/15 23:08
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/02/02 09:25
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
SUMIF関数で、「ブランク以外を...
-
セルを結合した時のエクセル集...
-
文字列から英数字のみを抽出す...
-
エクセル1行おきのセルを隣の...
-
自分の左隣のセル
-
EXCELでマイナス値の入ったセル...
-
エクセル2010 欠席者の名前を...
-
セルの内容表示が邪魔になる
-
excelで、空白を除いてデータを...
-
20日の締切日翌月5日の入金日の...
-
エクセルで、指定の値よりも大...
-
EXCELのcountif関数での大文字...
-
EXCEL マクロで2つの作業を行い...
-
EXECL バーコード生成でBarCode...
-
【Excel】4つとばしで合計する方法
-
エクセルVBA 行列の数を指定し...
-
Excelでなぜこのような式をつか...
-
DMAXの条件の設定方法
-
エクセル関数/任意の桁数の数...
-
【Excel】特定のデータが入って...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
SUMIF関数で、「ブランク以外を...
-
文字列から英数字のみを抽出す...
-
エクセル1行おきのセルを隣の...
-
自分の左隣のセル
-
エクセルで、指定の値よりも大...
-
excelで、空白を除いてデータを...
-
セルを結合した時のエクセル集...
-
エクセルで、A2のセルにA3...
-
エクセルで年月日から月日のみへ
-
エクセルに入力後、別シートの...
-
【Excel】4つとばしで合計する方法
-
Excelで大量のセルに一気に関数...
-
エクセルで特定のセル内にだけ...
-
EXCELのcountif関数での大文字...
-
EXCELでマイナス値の入ったセル...
-
条件付き書式の色付きセルのカ...
-
エラー「#REF」の箇所を置き換...
-
Excelで離れた位置のAVERAGEを...
-
同一セル内の重複文字を削除し...
-
週の労働時間を計算するエクセル
おすすめ情報