Module 4. 다항식으로 일괄 Fitting (Regression) 하기 - (6)실행을 위한 Sub 프로시저 작성

이전 게시물에서 일괄적인 fitting을 위한 기본적인 함수들은 모두 작성하였습니다. 

이제 매크로 실행창이나 리본 메뉴로 만들어 실제 실행하기 위한 Sub 프로시저를 작성하도록 하겠습니다.

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

Sub PolynomialFit_MultiXYPairs()
  On Error GoTo ErrorHandler
  Dim tSh As Worksheet, tRange As Range, tXCol() As Range, tYCol() As Range, tHN As Integer, tN As Long
  Dim i As Long, tOrder As Long, tStr As String, tWN As Long, tX(), tY(), tA()
  

  '일단 현재 활성화된 시트와 선택 영역을 지정해둡니다. XY쌍을 만들기 위해 Select 영역이 계속 바뀌기 때문에 미리 지정해두기 위해서 입니다.

  Set tSh = ActiveSheet

  Set tRange = Selection

  '이전에 작성해두었던 함수를 호출하여, 현재 선택된 영역을 X,Y쌍으로 만들어줍니다. 만약 X,Y 쌍이 하나도 없다면 바로 종료시킵니다.  

  tN = SelectedColIntoXYPair(tXCol, tYCol, tHN)
  If tN < 1 Then GoTo ErrorHandler
  'Fitting하려는 차수를 입력받습니다. 만약, 사용자가 취소를 누르게 되면 작업을 종료합니다. 또는 음수를 입력해도 취소합니다.

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

  '본격적인 계산에 들어가기 전에 계산 속도를 높이기 위해 계산 모드를 작동시킵니다. CalcModeOn은 예전의 게시물을 참고하시기 바랍니다. (바로가기)

  Call CalcModeOn(True)

  '계산 결과를 출력할 행의 위치를 미리 지정해둡니다. 현재 선택 영역의 아래에 출력할 예정입니다. 만약, 선택 영역에 데이터가 있다면 덮어씌우기 때문에, 데이터 보호가 필요하다면 Range.Insert method를 사용하여 미리 빈 행을 삽입해둘 수도 있습니다.

  tWN = tRange.Row + tRange.Rows.Count

  '미리 지정해둔 tN쌍의 X, Y 데이터 영역은 헤더 뿐만 아니라, 4각형 영역으로 선택하다보니 지정된 X, Y 영역의 하단에 빈 셀이나 문자열이 포함될 수 있습니다. 모든 데이터가 동일한 갯수의 데이터를 가진다면 불필요할 수 있으나, 데이터 수가 다르다면 간단하게나마 빈 셀 혹은 하단의 문자열 셀을 제외하고 숫자로 된 데이터만 X,Y 데이터로 사용해야합니다.

  '만약, X, Y 데이터 중간에 빈 셀이 포함되어 있거나 문자열이 포함되어있다면, Fitting 함수에서 오류가 발생할 수 있습니다. 필요하다면, 숫자로만 구성된 배열로 변환하도록 함수를 작성해두는 것이 좋습니다.

  '본 프로시저는 단순히 이러한 방식으로 일괄 작업이 가능하다는 예제일 뿐이며, 사용자가 취급하는 데이터 형태나, 필요한 자동화 수준에 따라 적절한 함수를 추가하는 것이 좋습니다.

  For i = 1 To tN

  '우선 헤더 부분은 숫자이든 문자이든 계산에서 제외시킵니다.
    Set tXCol(i) = Application.Intersect(tXCol(i), tXCol(i).Offset(tHN, 0))
    Set tYCol(i) = Application.Intersect(tYCol(i), tYCol(i).Offset(tHN, 0))

  '나머지 영역의 데이터를 배열로 일단 읽어옵니다. 셀에서 바로 빈셀 여부를 확인하는 것도 가능하지만, 갯수가 많을수록 셀에서 하나하나 바로 값을 읽어오는 것이 상대적으로 느립니다. 따라서, 미리 배열에 데이터를 가져온 후, 각 값의 형식이 숫자인지 확인합니다.

  '데이터 중간에 빈 셀이 없다면, 끝에서부터 X, Y 값이 숫자로 채워진 셀을 확인해서 X, Y 데이터 영역을 
    tX = tXCol(i).Value2
    tY = tYCol(i).Value2
    n = tXCol(i).Rows.Count
    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

  'X, Y데이터의 끝 위치를 확인했다면, X, Y 데이터를 다시 읽어줍니다.

  '엑셀에서 Range.End method를 사용할 수도 있으나, 뒷부분에 문자열이 붙어 있는 경우, 오류가 날 수 있습니다.

  '1차원 배열로 X, Y 데이터를 읽어올 수 있다면, 단순히 Redim Preserve로 배열의 크기를 줄여줄 수 있으나, 2차원 배열 데이터라 사용할 수 없습니다. 불편하지만 데이터 영역을 축소한 후 다시 데이터를 읽어와야 합니다.

    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

  '다항식 fitting을 한 후, 해당 Y열 하단에 a0, a1, ..., an을 출력해줍니다. WriteMat 함수는 2차원 배열을 워크시트에 출력해주는 함수입니다. (바로가기)

  '출력 방법은 각자의 목적에 맞게 새 워크시트에 출력하거나, Fitting 결과, Fitting 함수값, 잔차 등을 계산해서 출력해주도록 별도의 출력함수를 만들어주는 것도 좋습니다.

  '모든 작업이 완료되면, 자동 계산을 복원시켜주고 마칩니다.

    tA = PolynomialFit(tX, tY, tOrder)
    WriteMat tA, tSh, Cells(tWN, tYCol(i).Column)
  Next
ErrorHandler:
  Call CalcModeOn(False)
  Erase tXCol, tYCol, tX, tY, tA
End Sub

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

이상으로 일괄적으로 Fitting하는 매크로 소개를 마칩니다.

단순 Fitting 하나에도 상당히 많은 코드가 필요합니다. 이러한 함수들을 작게 쪼개어서 미리 만들어두면, 나중에는 Fitting 뿐만 아니라, Data Smoothing이나, 예측식을 만들거나, 일정한 기준을 벗어난 노이즈 데이터를 제거하는데에도 응용될 수도 있습니다. 본인만의 함수들을 많이 만들어보고, 또 진화시켜보시면, 필요할 때마다 조합하여 원하는 매크로를 빠르게 작성하실 수 있을 것입니다.