Veritcal / Perpendicular Offset에 따른 일괄 선형회귀 / Linear fitting 매크로 (1)

Offset 종류에 따른 1차식 fitting 매크로를 작성하고자 합니다.

다항식 fitting에서는 모든 계산식을 함수로 만들었습니다만, 1차식 fitting은 역행렬을 구할 필요없이 분산, 공분산, 평균 등과 같이 엑셀의 내장함수만 잘 조합하더라도 쉽게 구할 수 있기 때문에 별도의 함수는 가급적 만들지 않고 작성해보력 합니다. 또한, fitting 결과를 차트를 통해 쉽게 확인할 수 있다면 시각적으로 빠른 판단이 가능할 것 같습니다.

반복되는 여러개의 데이터가 있다고 하면, 이전에 만들어둔 SelectedColIntoXYPair 함수를 이용해서, 여러개의 X, Y쌍을 선택합니다. 원데이터를 손상시키지 않도록 선택된 열을 별로의 시트를 생성하여 복사한 다음, X, Y열의 데이터 갯수를 동일하게 만들어주고, 엑셀 내장함수를 이용하여 기울기, 절편과 결정 계수 R-Sq값을 구해줍니다. 마지막으로 원 데이터를 점으로, fitting된 결과를 직선으로 차트를 그려주는 것까지 만들어보도록 하겠습니다.

X, Y 쌍을 선택하는 것은 기존의 함수를 그대로 사용하도록 하겠습니다만, X, Y 데이터 갯수를 맞춰주는 함수는 TrimXYRange를 사용하려고 합니다. 다만, 이전에 만들어둔 함수는 단순히 X, Y열 중 빈셀만 제거해주는 것이었다면, X, Y fitting을 위해서는 X와 Y가 모두 채워져있는 셀만 선택해야하므로, 약간의 수정을 하도록 하겠습니다. 다만, 기존에 작성한 함수를 변경하지 않고 사용할 수 있어야겠지요.

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

Function TrimXYRange(iXCol As Range, iYCol As Range, Optional iHeader As Integer = 0, Optional iMatchNum As Boolean = False) As Range()

  '기존의 함수와 동일합니다만, Option으로 데이터 갯수를 맞출 것인지를 입력할 수 있도록 합니다. 기존 함수를 다른 매크로에 활용했더라도, 기본값이 설정되어있으니 코드 수정은 불필요합니다.

  Dim tSh As Worksheet, tXY(2) As Range, tHN As Integer, i As Long, tX(), tY(), tSN As Long, tFN As Long
  Set tSh = iYCol.Worksheet
  tHN = iHeader: If tHN < 0 Then tHN = 0
  If tHN > 0 Then Set tXY(0) = tSh.Range(iYCol.Cells(1, 1), iYCol.Cells(tHN, 1))
  Set tXY(1) = Application.Intersect(iXCol, tSh.UsedRange)
  Set tXY(1) = Application.Intersect(tXY(1), tXY(1).Offset(tHN, 0))
  Set tXY(2) = Application.Intersect(iYCol, tSh.UsedRange)
  Set tXY(2) = Application.Intersect(tXY(2), tXY(2).Offset(tHN, 0))
  
  tX = tXY(1).Value
  tY = tXY(2).Value

  '데이터 갯수를 맞춰주는 것으로 입력하면(iMatchNum=True), X와 Y 중 1개라도 빈칸인 경우 데이터를 제외시키도록 하며, 데이터 갯수를 맞춰줄 필요가 없다면(iMatchNum=False) X, Y가 모두 공란으로 되어 있는 셀만 제외하라는 것입니다.
  If iMatchNum Then
    For i = 1 To UBound(tY, 1)
      If Not (TypeName(tX(i, 1)) = "Empty" Or TypeName(tY(i, 1)) = "Empty") Then
        tSN = i
        Exit For
      End If
    Next
    For i = UBound(tY, 1) To 1 Step -1
      If Not (TypeName(tX(i, 1)) = "Empty" Or TypeName(tY(i, 1)) = "Empty") Then
        tFN = i
        Exit For
      End If
    Next
  Else
    For i = 1 To UBound(tY, 1)
      If Not (TypeName(tX(i, 1)) = "Empty" And TypeName(tY(i, 1)) = "Empty") Then
        tSN = i
        Exit For
      End If
    Next
    For i = UBound(tY, 1) To 1 Step -1
      If Not (TypeName(tX(i, 1)) = "Empty" And TypeName(tY(i, 1)) = "Empty") Then
        tFN = i
        Exit For
      End If
    Next
  End If
  Set tXY(1) = tSh.Range(tXY(1).Cells(tSN, 1), tXY(1).Cells(tFN, 1))
  Set tXY(2) = tSh.Range(tXY(2).Cells(tSN, 1), tXY(2).Cells(tFN, 1))
  TrimXYRange = tXY
  Erase tX, tY
End Function

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

두번째 함수는 시트의 일정한 영역 데이터를 복사하는 것으로, 엑셀에 내장된 Range.Copy method보다 빠르게 실행하도록 아래와 같이 작성해둡니다. .Copy, .Paste를 사용할 수 있으나, 값이나 셀의 서식을 함께 복사되다보니 반복작업수가 많아질수록 속도가 느려집니다. 아래와 같이 값만 복사하는 함수를 사용하게 되면, 조금더 빠르게 작업이 가능합니다.

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

Function CopyValues(iRange1 As Range, iRange2 As Range) As Range
  Dim tRange As Range

  '2번 range의 시작셀에서 1번 range의 행, 열 갯수만큼 range만큼 확장하여 값만 대입해줍니다. 복사가 완료되면 대상 영역을 결과값으로 반환해줍니다.
  Set tRange = iRange2.Worksheet.Range(iRange2.Cells(1, 1), iRange2.Cells(1, 1).Offset(iRange1.Rows.Count - 1, iRange1.Columns.Count - 1))
  tRange.Value = iRange1.Value
  Set CopyValues = tRange
End Function

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

다음 글에서는 일괄적으로 fitting하는 매크로를 작성하도록 하겠습니다.