Excel VBA質問箱 IV

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

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


9669 / 13644 ツリー ←次へ | 前へ→

【26007】各々条件を指定しセルの色を変える方法に... mayu 05/6/21(火) 16:28 質問[未読]
【26008】Re:各々条件を指定しセルの色を変える方法... m2m10 05/6/21(火) 16:36 発言[未読]
【26010】Re:各々条件を指定しセルの色を変える方法... Nossori 05/6/21(火) 18:54 回答[未読]
【26022】Re:各々条件を指定しセルの色を変える方法... m2m10 05/6/22(水) 8:07 回答[未読]
【26023】Re:各々条件を指定しセルの色を変える方法... ichinose 05/6/22(水) 8:34 発言[未読]
【26063】Re:各々条件を指定しセルの色を変える方... mayu 05/6/22(水) 18:18 質問[未読]
【26065】Re:各々条件を指定しセルの色を変える方... ichinose 05/6/22(水) 18:38 発言[未読]
【26076】Re:各々条件を指定しセルの色を変える方... mayu 05/6/22(水) 21:56 質問[未読]
【26077】Re:各々条件を指定しセルの色を変える方... ponpon 05/6/22(水) 23:04 発言[未読]
【26079】Re:各々条件を指定しセルの色を変える方... mayu 05/6/22(水) 23:55 質問[未読]
【26118】Re:各々条件を指定しセルの色を変える方... ponpon 05/6/23(木) 20:09 発言[未読]
【26075】Re:各々条件を指定しセルの色を変える方... ponpon 05/6/22(水) 21:53 発言[未読]
【26081】Re:各々条件を指定しセルの色を変える方法... りん 05/6/23(木) 10:25 回答[未読]
【26123】Re:各々条件を指定しセルの色を変える方法... mayu 05/6/24(金) 1:21 質問[未読]
【26126】Re:各々条件を指定しセルの色を変える方法... りん 05/6/24(金) 8:20 回答[未読]

【26007】各々条件を指定しセルの色を変える方法に...
質問  mayu  - 05/6/21(火) 16:28 -

引用なし
パスワード
   現在、下記の表を使用しています。
1日に1回、測定値が自動入力されます。
この時、基準値を外れた場合、セルの色を変えて分かり易くしたいです。
可能でしょうか?


  A   B      C
1
2 計器 基準値    測定値
3 113A 0.1<0.15   0.1
4 113B 0.1<0.25   0.3 ←基準値を超えた場合セルの色を変える
5 113C 0.7<     0.8
6 113D 2.0<5.0    4.0
7 114A 7.0±1.0   8.0
  ・  ・
  ・  ・
  ・  ・
全部で500行程度

【26008】Re:各々条件を指定しセルの色を変える方...
発言  m2m10  - 05/6/21(火) 16:36 -

引用なし
パスワード
   可能です。

【26010】Re:各々条件を指定しセルの色を変える方...
回答  Nossori  - 05/6/21(火) 18:54 -

引用なし
パスワード
   ▼mayu さん:
今晩は、誤解していたら御免なさい。
取りあせず一行目の条件を作成しました。
後は、これと同じように条件をコードに展開されると
如何でしょう。
一行目の測定値を「0.2」や「0.1」に変えてマクロを実行してください。
色がつきます。

Sub 基準値()

Dim R As Range
Dim MyR As Range

Set MyR = Range("A2", Cells(Rows.Count, 1).End(xlUp))

For Each R In MyR
If R.Value = "113A" And R.Offset(, 2).Value > 0.15 And R.Offset(, 3).Value < 0.1 Then
R.Offset(, 2).Interior.ColorIndex = 3
End If

Next

End Sub

計器の種類がべらぼうに多いとコードが非常に長くなるでしょうね。
20くらいかな?っと、かってに想像していますが?如何でしょう。

【26022】Re:各々条件を指定しセルの色を変える方...
回答  m2m10  - 05/6/22(水) 8:07 -

引用なし
パスワード
   改行でマクロを動かすサンプルです。

  Case の条件を増やせば、可能です。 


Sub 表示変更のマクロ開始()
   Application.OnKey "{ENTER}", "表示変更"
   Application.OnKey "~", "表示変更"
End Sub

Sub 表示変更のマクロ終了()
   Application.OnKey "{ENTER}"
   Application.OnKey "~"
End Sub

Public Sub 表示変更()

 If Mid(ActiveCell.Address, 1, 3) = "$C$" Then
   ' C列だけ色を付ける

  Select Case Range(ActiveCell.Address).Value
  
   Case 0.1
      Range(ActiveCell.Address).Interior.ColorIndex = 3
   Case 0.2
      Range(ActiveCell.Address).Interior.ColorIndex = 4
   Case 0.3
      Range(ActiveCell.Address).Interior.ColorIndex = 5
   Case Else
      Range(ActiveCell.Address).Interior.ColorIndex = 0
   
   End Select
   
 End If
   
   ActiveCell.Offset(1, 0).Select

End Sub

【26023】Re:各々条件を指定しセルの色を変える方...
発言  ichinose  - 05/6/22(水) 8:34 -

引用なし
パスワード
   mayu さん、皆さん
おはようございます。

>現在、下記の表を使用しています。
>1日に1回、測定値が自動入力されます。
>この時、基準値を外れた場合、セルの色を変えて分かり易くしたいです。
>可能でしょうか?
>
>
>  A   B      C
>1
>2 計器 基準値    測定値
>3 113A 0.1<0.15   0.1
>4 113B 0.1<0.25   0.3 ←基準値を超えた場合セルの色を変える
>5 113C 0.7<     0.8
>6 113D 2.0<5.0    4.0
>7 114A 7.0±1.0   8.0
>  ・  ・
>  ・  ・
>  ・  ・
>全部で500行程度

これをVBAで自動化して色を付けるのは結構大変だと思います。
基準値という色を付ける条件にあたるデータを
インタープリターのように構文解析しなければならないからです。
まず、基準値に入力されるデータをパターン化しなければなりませんよね?

サンプルデータ3行目から6行目のような

測定値が>xxxより大きく、yyyより小さいというパターン

±を使用した誤差表示のパターン

大きく分けるとサンプルデータからはこの二つですが、

それ以外にもありますか?
仮にこの二つだけだとしても基準値の形式がこのままでは
基準値の内容がどんなパターンなのか認識させるだけで大変です。

コードを簡単にするには、
この基準値の内容をひとつセルではなく、
例えば、3つのセルに分ける

>測定値が>xxxより大きく、yyyより小さいというパターン
これで見ると、

xxxにあたる数値を入れるセル
<  という条件を認識するセル
YYYにあたる数値を入れるセル

というように・・・・。

コードは、現在の表よりは簡単になると思いますよ!!

基準値に入る文字列のパターン化から検討されては
いかがですか?

【26063】Re:各々条件を指定しセルの色を変える方...
質問  mayu  - 05/6/22(水) 18:18 -

引用なし
パスワード
   Nossoriさん、m2m10さん、ichinoseさん アドバイス有難う御座います。

自分でも挑戦してみたのですが
うまく動作しません。 
考え方が間違っているのでしょうか?
恐れ入りますが改めてアドバイスお願いします。


Sub 計器113A()

Dim R As Integer
R = Range("c3").Value
If R < 0.1 Or R > 0.25 Then

Range("c3").Interior.ColorIndex = 8
Else
Range("c3").Interior.ColorIndex = 2

End If


End Sub

【26065】Re:各々条件を指定しセルの色を変える方...
発言  ichinose  - 05/6/22(水) 18:38 -

引用なし
パスワード
   ▼mayu さん:

こんばんは。
>
>自分でも挑戦してみたのですが
>うまく動作しません。 
>考え方が間違っているのでしょうか?
これね、その考え方が記述されていませんよね?

セルC3にはxxxという値が入っています。
本来なら、セルC3はxx色にならなければならないのに
yy色になってしまいます。

等ということを記述して下さいね!!
>
>
>Sub 計器113A()
>
>Dim R As Integer
'↑これが原因だと思いますが・・・
'例のような表のデータだとすると・・・、
'R=0.1だとRは整数なので0になってしまいます。
'小数だとすると何らかの加工があるとちょっと心配ですが、
dim R as double
'変更してみて下さい

>R = Range("c3").Value
>If R < 0.1 Or R > 0.25 Then
>
>Range("c3").Interior.ColorIndex = 8
>Else
>Range("c3").Interior.ColorIndex = 2
>
>End If
>
>
>End Sub

【26075】Re:各々条件を指定しセルの色を変える方...
発言  ponpon  - 05/6/22(水) 21:53 -

引用なし
パスワード
   ponponです。
 私もichinoseさんの考え方を提示しようと考えていたのですが、
データが必ず、C列ならば、
D,E,F,G列を使って基準値を表示したらいかがでしょうか?
ただichinoseさんが言っているように、
基準値のパターンがよく分かりません。

以下のようにすると、
(=が付くのか付かないのかよく分かりませんが、)
C列の値が基準値の範囲内かどうかを判断しやすくなると思います。

  A   B      C       D      E     F     G
1                       基準値 
2 計器 基準値    測定値   以上 最低値  以下  最高値
3 113A 0.1<0.15   0.1      >=  0.1     <=    0.15 
4 113B 0.1<0.25   0.3      >=  0.1     <=    0.25
5 113C 0.7<     0.8      >=  0.7      
6 113D 2.0<5.0    4.0      >=  2.0     <=    5.0
7 114A 7.0±1.0   8.0      >=  6.0     <=    8.0

関数を使った方がはやいかもしれませんが、・・・
すべてが、以上 以下でよいパターンなら、
以下コードで何とかなるかも。

Sub test()
  Dim myR As Range
  Dim C As Range
 
  Set myR = Range("C3", Range("C65536").End(xlUp))
  For Each C In myR
   If C.Value <= C.Offset(0, 2).Value Or C.Value >= C.Offset(0, 4).Value Then
    C.Interior.ColorIndex = 8
   Else
    C.Interior.ColorIndex = 2
   End If
  Next
 
End Sub

【26076】Re:各々条件を指定しセルの色を変える方...
質問  mayu  - 05/6/22(水) 21:56 -

引用なし
パスワード
   ichinose さん 有難う御座います。
下記のマクロでセルの色は変わるのですが
問題点として
数値を手入力した場合、色が付かない。
一度色の付いたセルに再入力した時に色が消えない。

どの様に工夫すればよいでしょうか?
アドバイスお願いいたします。


Sub 計器()

Dim R As Double


'113Aの測定値RがR<=0.1 Or R>=0.25 のときセルの色を変える
R = Range("c3").Value
If R <= 0.1 Or R >= 0.25 Then

Range("c3").Interior.ColorIndex = 8

End If

'113Bの測定値RがR<=0.1 Or R>=0.15 のときセルの色を変える
R = Range("c4").Value
If R <= 0.1 Or R >= 0.15 Then
Range("c4").Interior.ColorIndex = 8

End If

'113Cの測定値RがR<=0.7 のときセルの色を変える
R = Range("c5").Value
If R <= 0.7 Then
Range("c5").Interior.ColorIndex = 8

End If

'113Dの測定値RがR<=2 Or R>=5のときセルの色を変える
R = Range("c6").Value
If R < 2 Or R > 5 Then
Range("c6").Interior.ColorIndex = 8

End If


'以下永遠と続く


End Sub

【26077】Re:各々条件を指定しセルの色を変える方...
発言  ponpon  - 05/6/22(水) 23:04 -

引用なし
パスワード
   こんばんは。
↓のレスのようにセルに基準値が入力されているのなら、
シートモジュールにコピペしてください。
測定値が変更されると(手入力でも)色づけをします。
測定値が基準内なら色も白に戻ります。
基準値がB列にしか入れられないなら使えません。


Private Sub Worksheet_Change(ByVal Target As Range)

With Target
 If .Count > 1 Then Exit Sub
 If IsEmpty(.Value) Then Exit Sub
 If IsNumeric(.Value) = False Then Exit Sub
 
 If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
  Application.EnableEvents = False
  .Interior.ColorIndex = xlNone
  If .Value <= .Offset(0, 2).Value Or .Value >= .Offset(0, 4).Value Then
    .Interior.ColorIndex = 8
  Else
    .Interior.ColorIndex = 2
  End If
 End If
  Application.EnableEvents = True

End With

End Sub

【26079】Re:各々条件を指定しセルの色を変える方...
質問  mayu  - 05/6/22(水) 23:55 -

引用なし
パスワード
   ponpon さん ありがとう御座います。
説明不足で申し訳ありません。

基準値の記載について下記のようにB,C,Dセルに分ければ簡単でしょうか?
できれば測定値は日付順に列を追加しようと思います。
測定値の列は日付順であれば何処でも構いません。

また、関数の利用も考えたのですがコピー&ペーストが出来なくなると思いますので適さない次第です。


  A  B  C  D    E       F    G   H
2 計器  基準値    測定値6/1 測定値6/2  6/3  6/4
3 113A 0.1 < 0.15   0.1     0.1
4 113B 0.1 < 0.25   0.3     0.2
5 113C 0.7 <      0.8     0.8
6 113D 2.0 < 5.0    4.0     4.0
7 114A 6.0 <= 8.0    7.0     7.0
8 115A なし       1.0     2.0
  ・  ・
  ・  ・
  ・  ・
全部で500行程度


ご教授頂いた下記マクロ、今の私のレベルで理解でませんのでしたので
参考にして再度挑戦してみます。

Private Sub Worksheet_Change(ByVal Target As Range)

With Target
 If .Count > 1 Then Exit Sub
 If IsEmpty(.Value) Then Exit Sub
 If IsNumeric(.Value) = False Then Exit Sub
 
 If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
  Application.EnableEvents = False
  .Interior.ColorIndex = xlNone
  If .Value <= .Offset(0, 2).Value Or .Value >= .Offset(0, 4).Value Then
    .Interior.ColorIndex = 8
  Else
    .Interior.ColorIndex = 2
  End If
 End If
  Application.EnableEvents = True

End With

End Sub

【26081】Re:各々条件を指定しセルの色を変える方...
回答  りん E-MAIL  - 05/6/23(木) 10:25 -

引用なし
パスワード
   mayu さん、おはようございます。

>現在、下記の表を使用しています。
>この時、基準値を外れた場合、セルの色を変えて分かり易くしたいです。
>  A   B      C
>1
>2 計器 基準値    測定値
>3 113A 0.1<0.15   0.1
>4 113B 0.1<0.25   0.3 ←基準値を超えた場合セルの色を変える
>5 113C 0.7<     0.8
>6 113D 2.0<5.0    4.0
>7 114A 7.0±1.0   8.0
>  ・  ・

基準値の条件がここに書いてあるものしかないとして、条件付書式をマクロで付加していく方法です。
Sub test()
  Dim fmc As FormatCondition
  '
  For RR& = 3 To 500
   With Cells(RR&, 4)
     '念のため前回の設定の削除
     With .FormatConditions
      If .Count > 0 Then .Delete
     End With
     '式をチェックして条件付書式の条件を分岐
     A$ = Trim(Cells(RR&, 3).Value)
     If InStr(A$, "<") > 0 Then
      Md& = InStr(A$, "<")
      Select Case Md&
        Case Len(A$)
         Tp& = xlGreater
         V1# = Val(Left(A$, Md& - 1))
         fml1$ = Trim(CStr(V1#))
        Case Else
         Tp& = xlNotBetween
         V1# = Val(Left(A$, Md& - 1))
         V2# = Val(Mid(A$, Md& + 1, Len(A$)))
         fml1$ = Trim(CStr(V1#))
         fml2$ = Trim(CStr(V2#))
      End Select
     ElseIf InStr(A$, "±") > 0 Then
      Md& = InStr(A$, "±")
      Tp& = xlNotBetween
      V1# = Val(Left(A$, Md& - 1))
      V2# = Val(Mid(A$, Md& + 1, Len(A$)))
      fml1$ = Trim(CStr(V1# - V2#))
      fml2$ = Trim(CStr(V1# + V2#))
     Else
      Tp& = -1
     End If
     '
     If Tp& > 0 Then
      Select Case Tp&
       Case xlNotBetween
         Set fmc = .FormatConditions.Add( _
          Type:=xlCellValue, Operator:=Tp&, Formula1:=fml1$, Formula2:=fml2$)
       Case xlGreater
         Set fmc = .FormatConditions.Add( _
          Type:=xlCellValue, Operator:=Tp&, Formula1:=fml1$)
      End Select
      fmc.Interior.ColorIndex = 38
      Set fmc = Nothing
     End If
   End With
  Next
End Sub

こんな感じです。
横にデータが増えた場合は書式をコピーするだけです。

【26118】Re:各々条件を指定しセルの色を変える方...
発言  ponpon  - 05/6/23(木) 20:09 -

引用なし
パスワード
   こんばんは。
500行近くあるものが、Changeイベントでうまくいくか
自信がないのですが、基準値が提示されたパターンで、
B列、C列、D列に提示されたように入力されているなら、数値が入力されたときに
色づけできると思います。

Changeイベントの範囲は、
行はA列で見ています。
列は、2行目で見ています。
基準値がない場合はC列に"なし"とでも入れてください。
シートモジュールにコピペして、試してみてください。

うまくいかない場合は、上級者の回答をお待ちください。

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim myCol As Long
 Dim myRow As Long
 Dim myR As Range

With Target
 If .Count > 1 Then Exit Sub
 If IsEmpty(.Value) Then Exit Sub
 If IsNumeric(.Value) = False Then Exit Sub
 
 myCol = Cells(2, 256).End(xlToLeft).Column
 myRow = Cells(Rows.Count, 1).End(xlUp).Row
 Set myR = Range(Cells(3, 5), Cells(myRow, myCol))
 
 If Not Application.Intersect(Target, myR) Is Nothing Then
  Application.EnableEvents = False
  .Interior.ColorIndex = xlNone
  
  Select Case Cells(.Row, 3).Value
   Case Is = "<"
   If .Value <= Cells(.Row, 2).Value Or _
     .Value >= Cells(.Row, 4).Value Then
     .Interior.ColorIndex = 8
   Else
     .Interior.ColorIndex = 2
   End If
   Case Is = "<="
   If .Value < Cells(.Row, 2).Value Or _
     .Value > Cells(.Row, 4).Value Then
     .Interior.ColorIndex = 8
   Else
     .Interior.ColorIndex = 2
   End If
   Case Else
     .Interior.ColorIndex = 2
  
   End Select
   
 
 End If
  Application.EnableEvents = True

End With

End Sub

【26123】Re:各々条件を指定しセルの色を変える方...
質問  mayu  - 05/6/24(金) 1:21 -

引用なし
パスワード
   りん さん 有難うございます。

思考錯誤、皆さんの意見を学び取り組んでいます。

質問ですが、下記の部分はどの様な動きをしようとしているのかが
分かりません。恐れ入りますがお教え頂けませんでしょうか?

'式をチェックして条件付書式の条件を分岐
A$ = Trim(Cells(RR&, 3).Value)
     If InStr(A$, "<") > 0 Then
      Md& = InStr(A$, "<")
      Select Case Md&
        Case Len(A$)
         Tp& = xlGreater
         V1# = Val(Left(A$, Md& - 1))
         fml1$ = Trim(CStr(V1#))
        Case Else
         Tp& = xlNotBetween
         V1# = Val(Left(A$, Md& - 1))
         V2# = Val(Mid(A$, Md& + 1, Len(A$)))
         fml1$ = Trim(CStr(V1#))
         fml2$ = Trim(CStr(V2#))
      End Select

【26126】Re:各々条件を指定しセルの色を変える方...
回答  りん E-MAIL  - 05/6/24(金) 8:20 -

引用なし
パスワード
   mayu さん、おはようございます。

>質問ですが、下記の部分はどの様な動きをしようとしているのかが
>分かりません。恐れ入りますがお教え頂けませんでしょうか?

>'式をチェックして条件付書式の条件を分岐
> A$ = Trim(Cells(RR&, 3).Value)
 C列のRR&行目のセルの文字列を取得
>     If InStr(A$, "<") > 0 Then
 もし、A$に"<"を含むならば以下を実行(例:1<1.5 ,7<)
>      Md& = InStr(A$, "<")
 Md&に "<" の位置を取得
>      Select Case Md&
 Md&の位置で分岐します
>        Case Len(A$)
 文字列の長さと同じ位置ならば(最後にくるなら、"Data<")
>         Tp& = xlGreater
 条件付書式の式を「次の値より大きい」
>         V1# = Val(Left(A$, Md& - 1))
 数値取得
>         fml1$ = Trim(CStr(V1#))
 その値を文字列に変更
>        Case Else
 "<"の位置が最後以外にならば(Data1<Data2)
>         Tp& = xlNotBetween
 条件付書式の式を「次の値の間以外」
>         V1# = Val(Left(A$, Md& - 1))
>         V2# = Val(Mid(A$, Md& + 1, Len(A$)))
 数値取得( < をはさんで右側と左側)
>         fml1$ = Trim(CStr(V1#))
>         fml2$ = Trim(CStr(V2#))
 それぞれ文字列に変更
>      End Select
 分岐終了

です。
"<"が頭にくる場合は、例になかったので入っていません。
手動で 書式→条件付書式 でそれぞれ指定していくのをマクロでするとこうなりました。

9669 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free