Oscar Sun

                  Sub 詞學韻字相似度比對()
rt = ActiveSheet.UsedRange.Rows.Count
cou = 1
For i = 2 To rt
    x = Cells(i, "k")
    xL = Len(x)
    For j = i + 1 To rt
        y = Cells(j, "k")
        yL = Len(y)
        If Abs(yL - xL) / xL <= 1 / 2 Then '字串長度不能差太多
            For z = 1 To xL
                If InStr(1, y, Mid(x, z, 1), vbTextCompare) > 0 Then
                'If StrComp(Mid(x, z, 1), Mid(y, z, 1), vbTextCompare) = 0 Then
                    samecount = samecount + 1
                End If
            Next z
            If samecount / xL > 0.5 Then
                cou = cou + 1
                Sheet2.Cells(cou, 1) = Cells(i, "o")
                Sheet2.Cells(cou, 2) = Cells(j, "o")
                Sheet2.Cells(cou, 3) = Cells(i, "e")
                Sheet2.Cells(cou, 4) = Cells(j, "e")
                Sheet2.Cells(cou, 5) = Cells(i, "k")
                Sheet2.Cells(cou, 6) = Cells(j, "k")
                '會有一對多的關係
'                If Cells(i, "n") = "" Then
'                    Cells(j, "n") = Cells(i, "o")
'                Else
'                    Stop
'                    Cells(j, "p") = Cells(i, "o")
'
'                End If
            End If
        End If
        samecount = 0
    Next j
Next i
End Sub