Agilent사에서 개발한 ICP-MS의 Data Analysis 프로그램에서 결과를 엑셀 파일로 출력하면 기본적으로 결과가 가로 정렬된다. 이를 세로로 정렬하고, 관리 기준을 넘어선 원소를 표시해 주는 기능을 더한 VBA 프로시저를 소개한다.
기능
- ICP-MS(Agilent) 분석 결과의 스타일을 가로정렬에서 세로정렬로 변환.
- 관리 기준을 미리 입력한 경우 기준 초과시 색상으로 강조.
- 기준 미입력된 경우 값이 1초과할 경우 조건부 서식 발동.
- 동일 이름의 원소가 있을 경우 색상으로 강조.
- 분석 모드 표시 지우는 기능 추가.
코드
' METALLICA: metal analyze result trim system
' Copyright 2017-2018 TEAM CARTEL
'-------------------------------------------------------------------------------
' # FEATURES
' 1. "와 이래도 되나?" 싶을 정도로 간단하게 ICP-MS(Agilent) 분석 결과의 스타일을 가로정렬에서 세로정렬로 변환.
' 2. 인공지능... 처럼 보일 정도의 빠른 관리 기준 정리 기능.
' 2-1. 관리 기준이 설정되지 않은 항목의 경우, 분석 결과 값이 1 이상일 셀에서 조건부 서식 발동.
' 3. cheers
'-------------------------------------------------------------------------------
' # HOW TO USE
' 1. 전통적으로 Ctrl + q 에 단축키를 지정해 놓고 사용한다. 편리하다.
' 2. 관리 기준 정리가 올바르게 적용되지 않았을 경우에는 시료명을 알맞게 고치고 다시 실행하라.
' 2-1. 이미 변환이 적용된 상태에서는 가로 세로 정렬을 거르고 관리 기준 정리만 작동한다.
' 3. 관리 기준이 바뀔 경우에는 @metallica__trim_data() 보조 프로시저에서 값을 수정하라.
' 4. 설정.
' 4-1. A 열에 원소 이름만 남도록 하려면 @want_mode_trim 값을 True로 설정하라.
' 4-2. 관리기준에 포함되지 않은 항목을 숨기고 싶다면 @want_spec_trim 값을 True로 설정하라.
' 4-3. 테마를 적용시키고 싶다면 @want_set_theme 값을 True로 설정하라.
' 4-4. 알람창으로 정보를 표시하고 싶다면 @want_set_alram 값을 True로 설정하라.
'-------------------------------------------------------------------------------
' settings
Dim want_spec_trim As Boolean
Dim want_mode_trim As Boolean
Dim want_set_theme As Boolean
Dim want_set_alram As Boolean
' set global variants
Dim row As Integer, col As Integer
Sub METALLICA()
' METALLICA procedure was created by jinhui
' pause screen updateing
Application.ScreenUpdating = False
' detect row & col position
row = ActiveSheet.UsedRange.Rows.Count
'row = Range("A" & Rows.Count).End(xlUp).Row
col = ActiveSheet.UsedRange.Columns.Count
' get ready
If Cells(2, 2).Value <> "Rjct" Then
If Cells(1, 2).Value = "Acq. Date-Time" Or Cells(1, 2).Value = "Sample Name" Then
Call metallica__trim_data
Rows(ActiveSheet.UsedRange.Rows.Count).Hidden = False
Exit Sub
Else
If want_set_alram = True Then
MsgBox "Q를 적용할 수 없는 파일입니다."
End If
Exit Sub
End If
End If
ActiveSheet.UsedRange.Offset(0, 2).Copy
Cells(row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("1:" & row).Delete
row = ActiveSheet.UsedRange.Rows.Count
col = ActiveSheet.UsedRange.Columns.Count
Call metallica__trim_data
Call metallica__set_theme
Call metallica__sign
Range("A1").Select
End Sub
Sub metallica__trim_data()
' 1. 단일 시료의 분석 결과일 경우
' 1) 기준에 없는 원소는 숨겨진다.
'
' 2. 복수 시료의 분석 결과일 경우
' 1) 모든 시료에서 기준에 없는 원소는 숨겨진다.
' 2) 일부 시료에만 기준이 있는 원소는 다른 시료의 결과에서 회색 글자로 표시된다.
'
' 3. cheers
Range(Range("C3"), Cells(row, col)).Font.Color = RGB(150, 150, 150)
Cells.FormatConditions.Delete
Dim sample As String, list_element
If want_spec_trim = True Then
Rows("3:" & row).Hidden = True
End If
For j = 3 To col
If InStr(Cells(2, j), " ") = 0 Then
sample = UCase(Cells(2, j))
Else
sample = UCase(Left(Cells(2, j), InStr(Cells(2, j), " ") - 1))
End If
Select Case sample
Case "NMP" ' updated at 2019.07.
ReDim list_element(15)
list_element = Array( _
Array("Li", 0.06), Array("Be", 0.09), Array("Na", 0.8), Array("Mg", 0.2), Array("Al", 0.7), _
Array("K", 0.8), Array("Ca", 0.5), Array("Cr", 0.3), Array("Mn", 0.2), Array("Fe", 0.7), _
Array("Ni", 0.5), Array("Co", 1), Array("Cu", 0.2), Array("Zn", 0.5), Array("Sn", 1), _
Array("Pb", 1) _
)
Case "DI", "DI-W", "WATER" ' updated at 2020.03.
ReDim list_element(5)
list_element = Array( _
Array("Cr", 500), Array("Fe", 500), Array("Co", 500), Array("Ni", 500), Array("Cu", 500), _
Array("Zn", 500) _
)
Case Else
ReDim list_element(0)
list_element(0) = Array("ELSE", 1)
Rows("3:" & row).Hidden = False
Range(Cells(3, j).Address & ":" & Cells(row, j).Address).Font.Color = 0
End Select
Dim element As String, e_position As Integer, e_name As String
For i = 3 To row
element = Cells(i, 1).Value
e_position = InStr(element, " ")
Dim e_th As Integer
e_length = InStr(e_position + 2, element, " ") - e_position - 2
e_name = Mid(element, e_position + 2, IIf(e_length > 0, e_length, 0))
e_name = IIf(e_name = "", element, e_name)
If j = 3 And want_mode_trim = True Then
Cells(i, 1) = e_name
If e_name = "" Then
e_name = Cells(Cells(i, 1).End(xlUp).row, 1)
End If
End If
For Each n In list_element
If e_name = n(0) Or n(0) = "ELSE" Then
Rows(i).Hidden = False
Select Case Cells(i, 2)
Case "Conc. [ ppb ]", "Conc. [ ppt ]"
Cells(i, j).Font.Color = 0
Cells(i, j).FormatConditions.Add Type:=xlExpression, Formula1:="=AND(ISNUMBER(" & Cells(i, j).Address & "), " & Cells(i, j).Address & ">=" & n(1) & ")"
Cells(i, j).FormatConditions(1).StopIfTrue = False
With Cells(i, j).FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 200, 206)
.TintAndShade = 0
End With
With Cells(i, j).FormatConditions(1).Font
.Color = RGB(156, 0, 10)
End With
Case "CPS"
Case Else
End Select
Else
End If
Next
Next
Next
End Sub
Sub metallica__sign()
' add creater's sign for all results
Cells(ActiveSheet.UsedRange.Rows.Count + 1, ActiveSheet.UsedRange.Columns.Count).Select
Selection.Value = "METALLICA procedure was created by JINHUI"
With Selection.Font
.Size = 8
.Color = RGB(207, 201, 209)
End With
End Sub
Sub metallica__set_theme()
' set theme
Range("A1:A2").Merge
Cells(1, 1) = "Sample"
If Range("B3") = "Conc. [ ppt ]" Then
Range(Range("C3"), Cells(row, col)).NumberFormat = "?0.0"
Else
Range(Range("C3"), Cells(row, col)).NumberFormat = "?0.000"
End If
With ActiveSheet.UsedRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.UsedRange.Select
Dim list_border_full As Variant, list_border_inner As Variant, list_border_outer As Variant
list_border_full = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
list_border_inner = Array(xlInsideVertical, xlInsideHorizontal)
list_border_outer = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
For Each Position In list_border_outer
With Selection.Borders(Position)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Next
If want_set_theme = True Then
For Each Position In list_border_inner
With Selection.Borders(Position)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249977111117893
.Weight = xlThin
End With
Next
With Range("B1:B" & row).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Range("A1:B" & row).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
With Range(Range("A1"), Cells(2, col)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
If Len(Range("A3")) > 5 Then
Range("A:A").FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(A:A," + Chr(34) + "*" + Chr(34) + "&MID(A1, FIND(" + Chr(34) + " " + Chr(34) + ",A1)+1,FIND(" + Chr(34) + " " + Chr(34) + ",A1,FIND(" + Chr(34) + " " + Chr(34) + ",A1)+1)+4-FIND(" + Chr(34) + " " + Chr(34) + ",A1))&" + Chr(34) + "*" + Chr(34) + ")>1"
Else
Range("A:A").FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(A:A, A1)>1"
End If
Range("A:A").FormatConditions(1).StopIfTrue = False
With Range("A:A").FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 235, 156)
.TintAndShade = 0
End With
With Range("A:A").FormatConditions(1).Font
.Color = RGB(156, 101, 0)
End With
ActiveWindow.DisplayGridlines = False
Application.Goto Reference:=Range("a1"), Scroll:=True ' scroll to left top
Range("C3").Select
ActiveWindow.FreezePanes = True
End If
End Sub
Sub METALLICA_shipments()
want_spec_trim = False
want_mode_trim = True
want_set_theme = True
want_set_alram = True
Call METALLICA
End Sub
Sub METALLICA_OH()
want_spec_trim = True
want_mode_trim = True
want_set_theme = True
want_set_alram = True
Call METALLICA
End Sub끝.
