[엑셀 VBA] 두 단어의 일치도(%) 산출 매크로 #2 (일반화된 방법)

S Y N O P S I S #두 단어의 일치도(%) 산출하기

• 기존 포스팅(링크)의 한계점을 보완한 매크로이다.
• 일치도 산출 매크로를 사용자정의 함수로 정의하고, 2개의 셀을 입력받아 일치도를 산출하도록 했다.
• 기존 포스팅과 마찬가지로 연속된 글자일 경우에만 산출한다.
• 작동방식: 아래 화면과 같이 단어목록1과 단어목록2를 순차적으로 비교하여 C열에 일치도를 산출한다.

매크로 Output

VBA Code

Option Explicit
Sub max_common_text()
Dim lastRow As Long
Dim k As Long

With ActiveSheet.UsedRange
  lastRow = .Row + .Rows.Count - 1  '마지막 행 번호
End With

For k = 2 To lastRow  '1행 Header가 있는 경우 2행부터(행머리가 없으면 2를 1로 변경)
  With ActiveSheet
    .Cells(k, "C") = Format(resemble(.Cells(k, "A"), .Cells(k, "B")), "0.0%") 'A, B 열 단어 목록 비교 (필요시 변경하면 됨), 일치도를 C열에 산출, (필요시 변경하면 됨)
  End With
Next k

End Sub

Function resemble(ByVal x As Range, ByVal y As Range) As Double
'여기서부터 일치도 산출을 위한 사용자정의 함수
Dim dp(500, 500) As Long  'dp500 => 최대 글자수 500으로 제한
Dim myMax As Long
Dim i As Long
Dim j As Long

dp(1, 0) = 0
dp(0, 1) = 0
myMax = 0 '최댓값을 0으로 초기화


For i = 1 To Len(x.Value)
  For j = 1 To Len(y.Value) - i + 1
    dp(i, j) = WorksheetFunction.Max(Len(x.Value) - Len(Replace(x.Value, Mid(y.Value, i, j), "", , j)), dp(i, j - 1))
    If myMax <= dp(i, j) Then 'dp가 큰 경우 최대값 갱신
      myMax = dp(i, j)
    End If
  Next j
Next i

resemble = myMax / WorksheetFunction.Max(Len(x.Value), Len(y.Value))  '기준열 없이 둘 중 긴 단어를 분모로
'resemble = myMax / Len(y.Value)  기준열을 단어목록 2로 하고싶은 경우 위 행을 삭제하고 이 코드 적용

'dp(i, j) = i번째 글자부터 j개의 연속된 글자가 겹치는 최대 부분 개수
'dp(i, j) = max(i번째 글자부터 j개의 연속된 글자가 겹치는 개수, i번째 글자에서 j-1번째 글자까지 겹치는 개수)

End Function

매크로 실행 동영상(추후 업로드 예정)

매크로 예시파일

resemble.zip

 Copyright (2018) Ruahneuma. All Rights Reserved.