公差を設定して判定するマクロ

質問

規格を設けて判定するマクロについて教えてください。

下記のようなマクロがあるとき、現在はE列、H列、K列が同じ数値の場合は
塗りつぶしが行われるようになっています。

これを少し改造して、B4セルに公差の数値を入力した時
E列の数値を基準とし、H列、K列がE列からB4セルに入力した公差内なら色を付けるような
マクロを組みたいです。

例えばB4セルに2と入力してあるとします。
E列の数値が4.2だとした場合
H列は2.2、K列は6.2ならE列の数値の±2なので塗りつぶしされる。

E列の数値にB4セルの入力した数値の±をH列、K列を超える場合は
塗りつぶしは行わない、という感じです。

わかりずらい説明で申し訳ありませんが、宜しくお願いします。

Sub 判定仮()
Dim i As Integer, j As Integer

Range(Cells(3, "L"), Cells(32, "L")).ClearContents
Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0

For i = 3 To 32
If WorksheetFunction.CountIf(Rows(i), Cells(i, "E")) > 2 Then
If Cells(i, "E").Row Mod 2 = 1 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
Cells(i, "L") = "OK"
Else
If Cells(i, "E").Row Mod 2 = 0 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
Cells(i, "L") = "OK"
End If
End If
End If
Next

If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub

回答No.2

chie65536（@chie65535） · ベストアンサー

Sub 判定仮()
Dim i As Integer, j As Integer
Dim k As Double

Range(Cells(3, "L"), Cells(32, "L")).ClearContents
Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0
k = Cells(4, 2) ’B4セルの値

For i = 3 To 32
If Abs(Cells(i, "E") - Cells(i, "H")) <= k And Abs(Cells(i, "E") - Cells(i, "K")) <= k Then

If i Mod 2 = 1 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
Cells(i, "L") = "OK"
Else
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
Cells(i, "L") = "OK"
End If
End If
Next

If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub

無意味な式、無意味な判定文は削除しました。

例えば
Cells(i, "E").Row
は、常に
i
と同じ値を返すので
If Cells(i, "E").Row Mod 2 = 1 Then
は
If i Mod 2 = 1 Then
で構いません。

また、
If i Mod 2 = 1 Then
でElseに来た時は
If Cells(i, "E").Row Mod 2 = 0 Then
は「常に成り立つ」ので、まったく無意味です。

回答No.9

ushi2015

こんにちは、No1です。
元のコード、良く見てなかったのですが色々おかしかったみたいですね。
他の方のレス参考に修正しました。
まだおかしいかも、
Sub 判定仮()
　　Dim i As Integer, j As Integer
　　Dim L As Variant
　　Dim H As Variant

　　Range("L3:L32").ClearContents
　　Range("E3:K32").Interior.ColorIndex = 0

　　For i = 3 To 32
　　　　L = Cells(i, "E") - Cells(i, "B")
　　　　H = Cells(i, "E") + Cells(i, "B")

　　　　If Cells(i, "E") <> "" Then
　　　　　　If Cells(i, "H") >= L And Cells(i, "H") <= H And _
　　　　　　　　Cells(i, "K") >= L And Cells(i, "K") <= H Then
　　　　　　　　　　If i Mod 2 = 1 Then
　　　　　　　　　　　　Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
　　　　　　　　　　　　Cells(i, "L") = "OK"
　　　　　　　　　　Else
　　　　　　　　　　　　Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
　　　　　　　　　　　　Cells(i, "L") = "OK"
　　　　　　　　　　End If
　　　　　　End If
　　　　End If
　　Next

　　If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
　　　　MsgBox "データチェックOK(^O^)b"
　　End If
End Sub

お礼

御回答ありがとうございました。

再度、頂いたマクロを試してみましたが
やはり上手く機能致しませんでした。

せっかく考えて頂いたのに申し訳ありません。

回答No.8

kkkkkm

No7の補足です　なんどもすみません

例えば今回の場合E3に2がありH3、K3どちらかが空白だった場合OKになるのを防ぐため

と

Cells(i, "E"), Cells(i, "H"), Cells(i, "K"))
上記の3個のセルすべて空白の場合があればその行がOKになるのを防ぐため

です。

お礼

御回答ありがとうございました。

頂いたマクロで目的の事が行えました。

また何度も細かくマクロの意味などを教えて頂きありがとうございました。
今後ともよろしくお願いします。

回答No.7

kkkkkm

No6の補足です
条件に
WorksheetFunction.Count(Range(Cells(i, "E"), Cells(i, "K"))) > 2
があるのは
例えば今回の場合E3に2がありH3、K3どちらかが空白だった場合OKになるのを防ぐためですので、公差とセルに入力されている数値の差が0になったときに空白のセルが100%ない場合には不要な条件になります。

またE,H,K列の間の列にデータが入る場合には
WorksheetFunction.Count(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")) > 2
に変更してください。

Cells(i, "E").Rowの件は他の方が指摘されている通り(i=Row)ですが、たぶんこの方が後から見てRowが入っていて行の事だとわかるのであえてそうしてるのだと思ってそのままにしてます。

他、変更した部分はなぜそうしてるのか理由がわからなかったので勝手ながら変更しています。

回答No.6

kkkkkm

No5の訂正です。
flgは利用しなくてもいいです。他の事を考えてたのでflgのままだしてしまいました。

Sub 判定仮()
Dim i As Integer, j As Integer

Range(Cells(3, "L"), Cells(32, "L")).ClearContents
Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0

For i = 3 To 32
If Abs(Cells(i, "E") - Cells(i, "H")) <= Range("B4") And Abs(Cells(i, "E") - Cells(i, "K")) <= Range("B4") _
And WorksheetFunction.Count(Range(Cells(i, "E"), Cells(i, "K"))) > 2 Then
If Cells(i, "E").Row Mod 2 = 1 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
Else
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
End If
Cells(i, "L") = "OK"
End If
Next

If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub

回答No.5

kkkkkm

以下でいかがでしょう

Sub 判定仮()
Dim i As Integer, j As Integer
Dim flg As Boolean

Range(Cells(3, "L"), Cells(32, "L")).ClearContents
Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0

For i = 3 To 32
flg = False
If Abs(Cells(i, "E") - Cells(i, "H")) <= Range("B4") And Abs(Cells(i, "E") - Cells(i, "K")) <= Range("B4") _
And WorksheetFunction.Count(Range(Cells(i, "E"), Cells(i, "K"))) > 2 Then
flg = True
End If
If flg = True Then
If Cells(i, "E").Row Mod 2 = 1 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
ElseIf Cells(i, "E").Row Mod 2 = 0 Then 'else とif を2行に書かずにelseifがありますのでそちらを利用しましたendifが1個減ります
'↑ここの条件式はいらないと思いますよMod 2 の結果は1か0しかありませんのでelseだけでいいと思います
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
End If
Cells(i, "L") = "OK" '上のif(modの部分)で条件が一致してもしなくてもok記載するのでifから外に出しました。
End If
Next

If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub

回答No.4

chie65536（@chie65535）

追記。

40 - (i Mod 2) * (40 - 6)

の部分は

40 - (i Mod 2) * 34

にしてしまっても良いですが、判り難くなるので、こうしてあります。こうしてあると「(40 - 6)」の式の部分で「6か40の値を作っている」のが一目瞭然です。

「(i Mod 2)」は「0か1」なので、「(i Mod 2) * (40 - 6)」は「0か34」になります。

なので「40 - (i Mod 2) * (40 - 6)」は「iが奇数なら6、iが偶数なら40」になります。

後でプログラムを見ても理解できるように、以下のようにしておいたほうが良いです。

Const OddColor As Integer = 6
Const EvenColor As Integer = 40

Sub 判定仮()
（略）
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = EvenColor - (i Mod 2) * (EvenColor - OddColor)
（略）
End Sub

お礼

御回答ありがとうございました。

頂いたマクロで目的の事が出来ました。
またマクロの解説や、違ったパターンのマクロも教えて頂き
勉強になりました。
今後とも、よろしくお願います。

回答No.3

chie65536（@chie65535）

因みに、以下のようにすると、奇数行、偶数行の判定が不要になります。

Sub 判定仮()
Dim i As Integer, j As Integer
Dim k As Double

Range(Cells(3, "L"), Cells(32, "L")).ClearContents
Range(Cells(3, "E"), Cells(32, "K")).Interior.ColorIndex = 0
k = Cells(4, 2)

For i = 3 To 32
If Abs(Cells(i, "E") - Cells(i, "H")) <= k And Abs(Cells(i, "E") - Cells(i, "K")) <= k Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40 - (i Mod 2) * (40 - 6)
Cells(i, "L") = "OK"
End If
Next

If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub

回答No.1

ushi2015

こんにちは
こんな感じでしょうか？
Sub 判定仮()
　　Dim i As Integer, j As Integer
　　Dim L As Variant
　　Dim H As Variant

　　Range("L3:L32").ClearContents
　　Range("E3:K32").Interior.ColorIndex = 0

　　For i = 3 To 32
　　　　L = Cells(i, "E") - Cells(i, "B")
　　　　H = Cells(i, "E") + Cells(i, "B")

　　　　If Cells(i, "E") <> "" And Cells(i, "H") >= L And Cells(i, "K") >= H Then
　　　　　　If Cells(i, "E").Row Mod 2 = 1 Then
　　　　　　　　Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 6
　　　　　　　　Cells(i, "L") = "OK"
　　　　　　Else
　　　　　　　　If Cells(i, "E").Row Mod 2 = 0 Then
　　　　　　　　　　Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K")).Interior.ColorIndex = 40
　　　　　　　　　　Cells(i, "L") = "OK"
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　Next

　　If WorksheetFunction.CountIf(Range("L3:L32"), "OK") > 29 Then
　　　　MsgBox "データチェックOK(^O^)b"
　　End If
End Sub

補足

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

頂いたマクロを試してみましたが、上手く機能致しませんでした。

私の説明が悪かったかもしれないので、再度ご説明致します。

例えばB4セルに2と入力されているとします。
E3からE32のセルには1.012や1.524など、色々な数値が入力されています。

今回はE3、H3、k3でお話をします。

E3に1.012と入力されている
H3には1.536と入力されている
k3には0.956と入力されている

この場合、B4セルに入力されているのは2ですから、基準のE3の数値1.012の±2までの数値がH3とk3に入っていれば塗りつぶしが行われるといったことです。

今回であれば±2以内に入っているので、塗りつぶしは行われます。
またH3、K3どちらがプラス方向とかマイナス方向になるといった決まりはありません。
両方プラス方向にズレるの時もあれば、両方マイナス方向にズレるの場合もあります。

もし言葉足らずの所があれば、申し訳ありませんがご指摘頂ければと思います。
よろしくお願いします。