两个中文字符串中找出相同的部分，看看怎么改呢？

两个中文字符串中找出相同的部分，看看怎么改呢？
这段程序我想得到的结果为“中国”，可最后为中中国。请教诸位怎么改改呢？
'Option Explicit
Private Sub Command1_Click()
Dim XiangTong As String
Dim str As String
Text1 = "中国大好河山"
Text2 = "美丽中国行"
mm = Len(Text1)
nn = Len(Text2)
If mm >= nn Then
For xx = 1 To mm
For yy = 1 To nn
str = Mid(Text2, yy, 1)
zz = InStr(xx, Text1, str)
If zz <> 0 Then
XiangTong = XiangTong & Mid(Text1, xx, 1)
End If
Next yy
Next xx
End If
Text3 = XiangTong
End Sub