Module 5. Savitzky-Golay smoothing - (5)실행 매크로 작성

매크로 실행창을 통해 실제 사용자가 사용하게 될 매크로를 작성합니다.

기본적인 순서는 SelectedColIntoXYPair 함수를 사용하여 여러 개의 X, Y 데이터 쌍을 선택하고, Fitting 차수, 미분차수 및 계산을 위한 데이터 폭을 입력받은 후, 각각을 smoothing하고, 새로운 시트에 원데이터, smoothing 결과 및 미분값을 출력해주도록 합니다.

'----------------------------------------

Sub Smoothing_SavitzkyGolay()
  On Error GoTo ErrorHandler
  Dim tSh As Worksheet, tRange As Range, tShEx As Worksheet, tWrite As Range
  Dim tXCol() As Range, tYCol() As Range, tHN As Integer, tN As Long, tHeader As Range, tX(), tY(), tA(), tFit() As typeArray
  Dim i As Long, j As Long, k As Long, tOrder As Long, tDiffOrder As Long, tWidth As Long, tStr As String, tRN As Long, tCN As Long
  

  '현재 활성화된 시트와 선택 영역을 변수에 입력해둔 후, 선택 열에 대하여 X, Y쌍으로 분해해줍니다.
  Set tSh = ActiveSheet
  Set tRange = Selection
  
  tN = SelectedColIntoXYPair(tXCol, tYCol, tHN)
  If tN < 1 Then GoTo ErrorHandler
  

  'Fitting 차수를 입력받습니다.
  tStr = InputBox("Fitting 차수를 입력하세요.", "Fitting 차수 입력", 3)
  If StrPtr(tStr) = 0 Then GoTo ErrorHandler
  tOrder = Int(Val(tStr))
  If tOrder < 0 Then GoTo ErrorHandler
  

  '미분값을 구하려면, 미분 차수를 입력받되, 음수 또는 미분차수가 fitting 차수보다 높으면 미분계수를 계산하지 않도록 합니다.
  tStr = InputBox("미분 차수를 입력하세요.", "미분 차수 입력", 1)
  If StrPtr(tStr) = 0 Then GoTo ErrorHandler
  tDiffOrder = Int(Val(tStr))
  If tDiffOrder < 1 Or tDiffOrder > tOrder Then tDiffOrder = -1

  'Fitting에 사용할 데이터 수는 전체 데이터의 5%로 기본값을 입력해둡니다. 사용자가 이 값을 보고, 높이거나 낮출 수 있습니다. 
  n = Int(tXCol(1).Rows.Count * 0.05)
  tStr = InputBox("Smoothing에 사용할 데이터 수를 입력하세요.", "폭 입력", n)
  If StrPtr(tStr) = 0 Then GoTo ErrorHandler
  tWidth = Int(Val(tStr))
  If tWidth < 0 Then GoTo ErrorHandler
  
  Call CalcModeOn(True)
  

  '계산 결과를 출력할 시트를 생성하고, 이름을 변경합니다. 새 시트의 위치는 현재 시트의 바로 옆에 생성하도록 합니다.
  Set tShEx = ActiveWorkbook.Sheets.Add(After:=tSh)
  tShEx.Name = NewSheetName(tSh.Name & "-SG", tShEx.Index)
  tShEx.Tab.ColorIndex = 8
  

  '계산 결과를 출력할 때, 원 데이터의 header를 기입해줍니다. 만약, 데이터의 header가 지정되지 않았다면, smoothing 결과에 출력될 1개의 header를 생성하도록 합니다.
  If tHN > 0 Then tRN = tHN Else tRN = 1
  If tDiffOrder > 0 Then tCN = 4 Else tCN = 3
  For i = 1 To tN

  '만약 header가 지정되어있다면, 이 영역을 출력 시트에 복사해주기 위해 임시로 영역을 저장해둡니다. 그외 X, Y 데이터 영역을 설정해주되, 각 데이터 끝에 불필요한 공란은 데이터 영역에서 삭제해줍니다.

    If tHN > 0 Then Set tHeader = tSh.Range(tYCol(i).Cells(1, 1), tYCol(i).Cells(tHN, 1))
    Set tXCol(i) = Application.Intersect(tXCol(i), tXCol(i).Offset(tHN, 0))
    Set tYCol(i) = Application.Intersect(tYCol(i), tYCol(i).Offset(tHN, 0))
    tX = tXCol(i).Value2
    tY = tYCol(i).Value2
    n = UBound(tX, 1)
    For j = UBound(tX, 1) To 1 Step -1
      If TypeName(tX(j, 1)) = "Double" And TypeName(tY(j, 1)) = "Double" Then
        n = j
        Exit For
      End If
    Next
    Set tXCol(i) = Range(tXCol(i).Cells(1, 1), tXCol(i).Cells(n, 1))
    Set tYCol(i) = Range(tYCol(i).Cells(1, 1), tYCol(i).Cells(n, 1))
    tX = tXCol(i).Value2
    tY = tYCol(i).Value2

  'Smoothing 함수를 이용하여, 결과 및 미분계수를 반환받습니다. 만약, 미분계수를 계산하지 않는다면, X, Y, Smoothing 결과를 3열에 출력하고, 미분계수를 계산한다면, 미분계수까지 4열에 출력해줍니다.

  'header가 없다면, 1행에 몇번째 X, Y 데이터인지 표기를 해줍니다. 불필요한 경우는 이부분을 변경하셔도 됩니다.

  '데이터는 WriteMat 함수를 이용하여 출력해줍니다.

    tFit = PFit_SavitzkyGolay(tX, tY, tWidth, tOrder, tDiffOrder)    
    With tShEx.Cells(1, tCN * (i - 1) + 1)
      .Value = "X" & k
      WriteMat tX, tShEx, .Offset(tRN, 0)
      If tHN > 0 Then
        tHeader.Copy
        .Offset(0, 1).PasteSpecial xlPasteAll
      Else
        .Offset(0, 1).Value = "Y" & k
      End If
      WriteMat tY, tShEx, .Offset(tRN, 1)
      .Offset(0, 2).Value = "Y" & k & "_SG"
      WriteMat tFit(0).Y, tShEx, .Offset(tRN, 2)
      If tDiffOrder > 0 Then
        .Offset(0, 3).Value = "Y" & k & "_Diff(Order=" & tDiffOrder & ")"
        WriteMat tFit(1).Y, tShEx, .Offset(tRN, 3)
      End If
    End With
  Next
ErrorHandler:
  Call CalcModeOn(False)
  Erase tXCol, tYCol, tX, tY, tA
End Sub

'----------------------------------------

이상과 같이 Savitzky-Golay Smoothing 매크로를 작성하였습니다. 그러나, 데이터 폭에 따라 smoothing된 결과가 불만족스러울 수 있기 때문에, 여러번 반복해야하는 수가 있습니다. 미리보기 형식으로 차트를 생성해주고, 적정한 수준의 데이터폭을 결정해줄 수 있다면 불필요한 반복작업을 하지 않아도 되겠지요.

차트를 처리하기 위한 함수들은 다음에 기회가 되면 작성해보도록 하겠습니다. 그후에 미리보기를 결합해서 위의 매크로를 수정해주면 보다 실용적인 매크로가 될 수 있을 것입니다.