Как отделить/отфильтровать текст на английском языке с китайского языка в Excel

Question

Я работаю над проектом, который включает в себя несколько файлов Excel с ячейками, содержащими английский, китайский или английский и китайский.

Мне нужно, чтобы строки были полностью на китайском языке и помещали их первыми. Затем мне нужны строки с китайскими и английскими иероглифами. И только тогда те, которые только на английском языке.

Я столкнулся со следующими тремя функциями, которые могли бы помочь мне пометить контент соответственно, но они, похоже, не работают должным образом, и я не могу понять, почему.

Function ExtractChn(txt As String) 
Dim i As Integer 
Dim ChnTxt As String 
For i = 1 To Len(txt) 
    If Asc(Mid(txt, i, 1)) < 0 Then 
     ChnTxt = ChnTxt & Mid(txt, i, 1) 
    End If 
Next i 
ExtractChn = ChnTxt 
End Function 

Function ExtractEng(txt As String) 
Dim i As Integer 
Dim EngTxt As String 
For i = 1 To Len(txt) 
    If Asc(Mid(txt, i, 1)) >= 0 Then 
     EngTxt = EngTxt & Mid(txt, i, 1) 
    End If 
Next i 
ExtractEng = EngTxt 
End Function 

Function CheckTxt(txt) 
Dim i As Integer 
Dim Eng As Integer 
Dim Chn As Integer 
Chn = 0 
Eng = 0 
For i = 1 To Len(txt) 
    If Asc(Mid(txt, i, 1)) > 0 Then 
     Eng = 1 
    Else: 
     Chn = 1 
    End If 
Next i 
If Chn = 1 And Eng = 1 Then 'Contains Both Eng & Chn 
    CheckTxt = "BOTH" 
Else: 
    If Chn = 1 And Eng = 0 Then 'Chn 
     CheckTxt = "CHN" 
    Else: 
     If Chn = 0 And Eng = 1 Then 'Eng 
      CheckTxt = "ENG" 
     End If 
    End If 
End If 
End Function 

Лицо, создавшее их, даже предоставило файл, демонстрирующий работу функций. Я прилагаю ссылку на файл, который имеет устройство следующее образом:

Text|English part of it|Chinese part of it|ExtractEng|ExtractChn|CheckTxt 

По замыслу автора, то CheckTxt результата должен отображать либо CH, ENG или BOTH. Тем не менее, он показывает только ENG, и я не могу понять, почему.

Любые идеи, как заставить его работать? Если нет более простого способа «предварительного фильтра» содержимого в Excel? Любая помощь будет высоко ценится.

Test Excel file from the developer

Answer 1

Это звучит как работа для регулярных выражений !!

Function getCharSet(Target As Range) As String 
    Const ChinesePattern = "[\u4E00-\u9FFF\u6300-\u77FF\u7800-\u8CFF\u8D00-\u9FFF]+" 
    Const EnglishPattern = "[A-Za-z]" 
    Dim results As String 
    Dim Data, v 
    Dim Regex1 As Object 
    Set Regex1 = CreateObject("VBScript.RegExp") 
    Regex1.Global = True 

    If Target.Count = 1 Then 
     Data = Array(Target.Value2) 
    Else 
     Data = Target.Value2 
    End If 

    For Each v In Data 

     If Not InStr(results, "CHN") Then 
      Regex1.Pattern = ChinesePattern 
      If Regex1.Test(v) Then 
       If Len(results) Then 
        getCharSet = "CHN" & " - " & results 
        Exit Function 
       Else 
        results = "CHN" 
       End If 
      End If 
     End If 

     If Not InStr(results, "ENG") Then 
      Regex1.Pattern = EnglishPattern 
      If Regex1.Test(v) Then 
       If Len(results) Then 
        getCharSet = results & " - ENG" 
        Exit Function 
       Else 
        results = "ENG" 
       End If 
      End If 
     End If 
    Next 
    getCharSet = results 

End Function 

Answer 2

Основной подход:

Sub Main() 

Dim sh As Worksheet 
Set sh = ActiveSheet 

Dim rng As Range 
Set rng = sh.Range("A6:D10") 

Call Separate_English_Chinese(rng) 

End Sub 

Sub Separate_English_Chinese(rng) 

Dim sh As Worksheet 
Set sh = rng.Parent 

Dim EnglishCharacters As String 
Dim colEng As Long, colChn As Long, colContains As Long 
Dim a As String, i As Long, k As Long 
Dim colFullText As Long, txtEnglish As String, txtChinese As String 
Dim Result As Long, Contains As String 
Dim First As Long, Last As Long 

First = rng.Row 
Last = rng.Rows.Count + rng.Row - 1 

EnglishCharacters = "qwertyuiopasdfghjklzxcvbnm" 

EnglishCharacters = UCase(EnglishCharacters) & LCase(EnglishCharacters) 

colFullText = 1 
colEng = 2 
colChn = 3 
colContains = 4 

For i = First To Last 

    a = sh.Cells(i, colFullText).Value 

    txtEnglish = "" 
    txtChinese = "" 

    For k = 1 To Len(a) 

     If InStr(EnglishCharacters, Mid(a, k, 1)) Then 
      txtEnglish = txtEnglish & Mid(a, k, 1) 
     Else 
      txtChinese = txtChinese & Mid(a, k, 1) 
     End If 

    Next 

    sh.Cells(i, colEng).Value = txtEnglish 
    sh.Cells(i, colChn).Value = txtChinese 

    Result = 0 
    If txtEnglish <> "" Then Result = Result + 1 
    If txtChinese <> "" Then Result = Result + 10 

    Select Case Result 

     Case 1 
     Contains = "ENG" 
     Case 10 
     Contains = "CHN" 
     Case 11 
     Contains = "BOTH" 
     Case Else 
     Contains = "" 

    End Select 

    sh.Cells(i, colContains).Value = Contains 

Next 

End Sub