如何检查字符串(或单元格)中是否包含kajji字符?

时间:2017-01-11 18:18:56

标签: excel vba unicode

我在一家日本公司工作。因此,发送给我的大多数excel表主要是日语。所以我创建了一个excel宏,提示用户选择他们想要翻译的一系列单元格。宏循环遍历获取单元格值的单元格范围,将其复制到Google翻译文本框,等待翻译,复制翻译,并将单元格值设置为翻译。

现在所有这一切都有效,我可以翻译我投入的任何范围。我遇到的问题是翻译文档所需的时间。我已尽力加快与谷歌的连接。接下来我看到减慢宏的速度是因为我无法找出一种简单的方法来确定一个单元格是否包含任何日语(平假名,片假名,汉字)。所以我正在寻找一个基本上这样做的功能:

Function isJapanese(cell as Range)
     If cell.Value is Japanese Then
            isJapanese = True
     Else
            isJapanese = False
     End If
End Function

我已经在检查字符串是否包含拉丁字母(使其跳过某些单元格),某些符号以及我能想到的任何其他字符或字符串仅对英语单元格而言是唯一的。

下面是我到目前为止的代码(我使用用户表单来获取翻译函数的变量)

Function Translate_Range(rng As String, in_exp As String, out_exp As String) As Boolean
Dim japCheck As Boolean, japCount As Integer, cellAddress As String, transText As String, langDesired As String, wkb As String, sht As String, searchRange As Range, doneCheck As Boolean
doneCheck = False
wkb = ActiveWorkbook.Name
sht = ActiveSheet.Name
Workbooks(wkb).Worksheets(sht).Activate
japCount = 0
japCheck = True
Set searchRange = Range(rng)
For Each cell In searchRange
    If cell.Value <> "" And InStr(cell.Text, "mm") = 0 And InStr(cell.Text, "±") = 0 Then
        japCheck = IsAlpha(cell.Text)
        If japCheck = True Then
            GoTo NextIteration
        Else
            transText = translate_string(cell.Address, in_exp, out_exp)
            ActiveSheet.Range(cell.Address).Value = transText
        End If
    End If
NextIteration:
    Next
    doneCheck = True
    Translate_Range = doneCheck
End Function

Private Function translate_string(cell As String, input_exp As String,  output_exp As String)
Dim str As String
str = ActiveSheet.Range(cell).Value
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.navigate "http://translate.google.com/#" & input_exp & "/" & output_exp & "/" & str
    Do Until IE.readyState = 4
        DoEvents
    Loop
Do Until result_data <> ""
    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For i = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
        result_data = result_data & Right(CLEAN_DATA(i), Len(CLEAN_DATA(i)) - InStr(CLEAN_DATA(i), ">"))
    Next
Loop
IE.Quit
translate_string = result_data
End Function

Private Function IsAlpha(strValue As String) As Boolean
    IsAlpha = strValue Like WorksheetFunction.Rept("[a-zA-Z]", Len(strValue))
End Function

我觉得必须有一个汉字字符的Unicode协议。在谈到这样的事情时,我只是非常缺乏经验(我是一名机械工程师,制作excel宏以使我的生活更轻松,所以我对这样的技术编程主题的知识缺乏抱歉)

1 个答案:

答案 0 :(得分:0)

这个从我链接的答案中大量借用的子,可以确定一个字符串是否有任何拉丁字符:

Sub t()
Dim k       As Long
Dim myString As String
myString = Range("Z1").Value  'Edit this as needed
Dim latinChars As Long

latinChars = 0
For k = 1 To Len(myString)
    If IsLatin(Mid(myString, k, 1)) Then
        ' Has latin characters
        latinChars = latinChars + 1
    End If
Next k

If latinChars = 0 Then
    ' Doesn't have latin characters
    Debug.Print "Doesn't have latin characters"
Else
    ' Has latin characters
    Debug.Print "Has latin characters"
End If

End Sub

Function IsLatin(Str As String) As Boolean
IsLatin = True
For i = 1 To Len(Str)
IsLatin = IsLatin And Abs(AscW(Mid(Str, i, 1)) - 64) < 64
Next i
End Function
相关问题