Visual Basic 字符串匹配

 Sub MatchWord()

'define sheet variables
Dim workSheet1 As Worksheet
Dim workSheet2 As Worksheet

'define variables for sheet1
Dim g_strLang As String
Dim g_strLangAR As String
Dim g_strLangFR As String

Dim st1_rngLang As Range
Dim st1_rngLangAR As Range
Dim st1_rngLangFR As Range
'define variables for sheet2
Dim st2_rngLang As Range
Dim st2_rngLangAR As Range
Dim st2_rngLangFR As Range

'initialize variable
g_strLang = "ZH"
g_strLangAR = "AR"
g_strLangFR = "FR"
Set workSheet1 = Worksheets("Sheet1")
Set workSheet2 = Worksheets("Sheet2")

Dim st1_findRng As Range
Dim st2_findRng As Range
'init ref language
Set st1_findRng = workSheet1.UsedRange.Rows(1).Find(what:=g_strLang, LookAt:=xlWhole)
Set st2_findRng = workSheet2.UsedRange.Rows(1).Find(what:=g_strLang, LookAt:=xlWhole)

If Not st1_findRng Is Nothing And Not st2_findRng Is Nothing Then
    Set st1_rngLang = workSheet1.UsedRange.Columns(st1_findRng.Column)
    Set st2_rngLang = workSheet2.UsedRange.Columns(st2_findRng.Column)
Else
    Set st1_rngLang = Nothing
    Set st2_rngLang = Nothing
    MsgBox "Can't Find Language ID for compare!"
    Exit Sub
End If
'init arabic language
Set st1_findRng = workSheet1.UsedRange.Rows(1).Find(what:=g_strLangAR, LookAt:=xlWhole)
Set st2_findRng = workSheet2.UsedRange.Rows(1).Find(what:=g_strLangAR, LookAt:=xlWhole)

If Not st1_findRng Is Nothing And Not st2_findRng Is Nothing Then
    Set st1_rngLangAR = workSheet1.UsedRange.Columns(st1_findRng.Column)
    Set st2_rngLangAR = workSheet2.UsedRange.Columns(st2_findRng.Column)
Else
    Set st1_rngLangAR = Nothing
    Set st2_rngLangAR = Nothing
End If
'init franch language
Set st1_findRng = workSheet1.UsedRange.Rows(1).Find(what:=g_strLangFR, LookAt:=xlWhole)
Set st2_findRng = workSheet2.UsedRange.Rows(1).Find(what:=g_strLangFR, LookAt:=xlWhole)

If Not st1_findRng Is Nothing And Not st2_findRng Is Nothing Then
    Set st1_rngLangFR = workSheet1.UsedRange.Columns(st1_findRng.Column)
    Set st2_rngLangFR = workSheet2.UsedRange.Columns(st2_findRng.Column)
Else
    Set st1_rngLangFR = Nothing
    Set st2_rngLangFR = Nothing
End If

Dim rngCell As Range
Dim rngFind As Range
Dim Sheet1_FindedCount As Integer
Dim Sheet1_TotalCount As Integer
Dim Sheet2_TotalCount As Integer
Sheet1_FindedCount = 0
Sheet1_TotalCount = workSheet1.UsedRange.Rows.Count
Sheet2_TotalCount = workSheet2.UsedRange.Rows.Count

For Each rngCell In st1_rngLang.Cells
    Set rngFind = st2_rngLang.Find(what:=rngCell.Value, LookAt:=xlWhole)
    If Not rngFind Is Nothing Then
        Sheet1_FindedCount = Sheet1_FindedCount + 1
        If Not st1_rngLangAR Is Nothing Then
            st1_rngLangAR.Rows(rngCell.Row).Value = st2_rngLangAR.Rows(rngFind.Row).Value
        End If
        
        If Not st1_rngLangFR Is Nothing Then
            st1_rngLangFR.Rows(rngCell.Row).Value = st2_rngLangFR.Rows(rngFind.Row).Value
        End If
    End If
Next rngCell

MsgBox "MatchFinish Sheet1_FindedCount = " & Format(Sheet1_FindedCount) & Chr(10) _
& "Sheet1_TotalCount = " & Format(Sheet1_TotalCount) & Chr(10) _
& "Sheet2_TotalCount = " & Format(Sheet2_TotalCount)

End Sub