みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

下記のようなマクロがあるとき、現在は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

投稿日時 - 2016-03-28 08:18:28

QNo.9150010

すぐに回答ほしいです

質問者が選んだベストアンサー

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
は「常に成り立つ」ので、まったく無意味です。

投稿日時 - 2016-03-28 11:20:17

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(9)

ANo.9

こんにちは、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

投稿日時 - 2016-03-28 14:41:19

お礼

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

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

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

投稿日時 - 2016-03-29 11:47:01

ANo.8

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

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



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

です。

投稿日時 - 2016-03-28 13:28:35

お礼

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

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

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

投稿日時 - 2016-03-29 11:46:24

ANo.7

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が入っていて行の事だとわかるのであえてそうしてるのだと思ってそのままにしてます。

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

投稿日時 - 2016-03-28 13:13:45

ANo.6

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

投稿日時 - 2016-03-28 12:02:47

ANo.5

以下でいかがでしょう

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

投稿日時 - 2016-03-28 11:50:29

ANo.4

追記。

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

投稿日時 - 2016-03-28 11:42:15

お礼

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

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

投稿日時 - 2016-03-29 11:45:22

ANo.3

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

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

投稿日時 - 2016-03-28 11:28:13

ANo.1

こんにちは
こんな感じでしょうか?
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

投稿日時 - 2016-03-28 09:19:14

補足

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

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

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

例えば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どちらがプラス方向とかマイナス方向になるといった決まりはありません。
両方プラス方向にズレるの時もあれば、両方マイナス方向にズレるの場合もあります。

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

投稿日時 - 2016-03-28 10:40:25

あなたにオススメの質問