[原创]

Public Sub TranslateAll()
'++++++++++++++++++++++++++++++++++++++++++++++++
'+++   Code By   icy/忽又一天                   +++
'+++   Email: [e-mail]                 +++
'+++   Q   Q: 365052003                         +++
'+++   Blog: Http://hi.baidu.com/suddenday/   +++
'++++++++++++++++++++++++++++++++++++++++++++++++
    On Error Resume Next
    Dim i As Integer, j As Integer
    For i = 0 To 200
        For j = 0 To 20
             ReplaceCellTxt i, j
        Next
    Next
    
End Sub

Private Sub ReplaceCellTxt(ByVal RowIndex As Double, ByVal ColIndex As Double)

    '替换指定单元格中的中文字符
    On Error Resume Next
    Dim i As Integer
    Dim PreText As String, CnText As Variant
     PreText = Cells(RowIndex, ColIndex)
     Debug.Print PreText
    
    If GetChn(PreText) <> "" Then
         CnText = Split(GetChn(PreText), ",")
    End If
    
    For i = 0 To UBound(CnText)
    
     CurText = TranslateWord(CnText(i))
     Debug.Print CurText
    
    If (Not CurText = "NotFound") And (Not Trim(CurText) = "") Then
         PreText = Replace(PreText, CnText(i), CurText)
         Cells(RowIndex, ColIndex) = PreText
    End If
    
    Next
    
End Sub

Private Function TranslateWord(ByVal StrWord As String) '查找指定字符串在词典中的解释

    On Error Resume Next
    Dim StrTemp As String
    Dim StrWords As Variant
    Open "D:\Dic.txt" For Input As #1
     TranslateWord = "NotFound"
    
    Do While Not EOF(1)
    
        Line Input #1, StrTemp
         Debug.Print StrTemp
         StrWords = Split(StrTemp, vbTab)
        If Trim(StrWords(0)) = Trim(StrWord) And UBound(StrWords) > 0 Then
             TranslateWord = StrWords(1)
            Exit Do
        End If
    
    Loop
    
    Close #1
    
End Function

Private Function GetChn(ByVal Str As String) As String  '截取字符串中的中文

    Dim i As Integer, j As Integer
    Dim ChnStr As String
    Dim IsPreCn As Boolean
     IsPreCn = False

    For i = 1 To Len(Str)
    
        If Asc(Mid(Str, i, 1)) < 0 Then
            If IsPreCn Then
                 ChnStr = ChnStr & Mid(Str, i, 1)
            Else
                 ChnStr = ChnStr & "," & Mid(Str, i, 1)
            End If
             IsPreCn = True
        Else
             IsPreCn = fasle
        End If
    Next
    
    If Mid(ChnStr, 1, 1) = "," Then
         ChnStr = Mid(ChnStr, 2, Len(ChnStr))
    End If
    
     GetChn = ChnStr

     Debug.Print GetChn

End Function