| |
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
こんな感じです。
横にデータが増えた場合は書式をコピーするだけです。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 05/6/23(木) 10:25 -
