Vba 如何在Excel中分离/筛选英文文本和中文文本_Vba_Excel_Function_Filter

Vba 如何在Excel中分离/筛选英文文本和中文文本

vba excel function filter

Vba 如何在Excel中分离/筛选英文文本和中文文本,vba,excel,function,filter,Vba,Excel,Function,Filter,我正在从事一个项目，其中包括多个Excel文件，单元格中包含英文、中文或中英文我需要保留完全用中文写的行，并将它们放在第一位。然后，我需要一行既有中文又有英文。只有那些只有英语的我遇到了以下3个函数，它们可以帮助我相应地标记内容，但它们似乎没有按预期工作，我也不知道为什么 Function ExtractChn(txt As String) Dim i As Integer Dim ChnTxt As String For i = 1 To Len(txt) If Asc(Mid(t

我正在从事一个项目，其中包括多个Excel文件，单元格中包含英文、中文或中英文

我需要保留完全用中文写的行，并将它们放在第一位。然后，我需要一行既有中文又有英文。只有那些只有英语的

我遇到了以下3个函数，它们可以帮助我相应地标记内容，但它们似乎没有按预期工作，我也不知道为什么

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

根据作者的意图，

CheckTxt

结果应显示

CH

、

ENG

，或

两者都显示。但是，它始终只显示ENG
，我不知道为什么
有什么办法让它工作吗？除非有更简单的方法“高级筛选”Excel中的内容？任何帮助都将不胜感激
这听起来像是正则表达式的工作

基本方法：
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

Sub-Main（）
将sh设置为工作表
设置sh=ActiveSheet
变暗rng As范围
设置rng=sh范围（“A6:D10”）
分别呼叫英语和汉语（rng）
端接头
分包英语汉语（rng）
将sh设置为工作表
设置sh=rng.Parent
模糊的英语字符作为字符串
暗颜色一样长，颜色一样长，颜色一样长
暗如弦，我如长，k如长
Dim col全文为长，TXTENGLESH为字符串，TXTECHINE为字符串
Dim结果为长，包含为字符串
先变暗一样长，后变暗一样长
第一个=rng.Row
Last=rng.Rows.Count+rng.Row-1
英语字符=“qwertyuiopasdfghjklzxcvnm”
EnglishCharacters=UCase（EnglishCharacters）和LCase（EnglishCharacters）
colFullText=1
科林=2
colChn=3
colContains=4
因为我=从第一到最后
a=sh.Cells（i，colFullText）.Value
txtEnglish=“”
txtChinese=“”
对于k=1至Len（a）
如果是InStr（英语字符，Mid（a，k，1）），那么
txtEnglish=txtEnglish&Mid（a，k，1）
其他的
txtChinese=txtChinese&Mid（a，k，1）
如果结束
下一个
sh.Cells（i，colEng）.Value=txtEnglish
sh.Cells（i，colChn）.Value=txtChinese
结果=0
如果txtEnglish“”则结果=结果+1
如果txtChinese“”则结果=结果+10
选择案例结果
案例1
Contains=“ENG”
案例10
Contains=“CHN”
案例11
Contains=“两者”
其他情况
Contains=“”
结束选择
sh.Cells（i，colContains）.Value=Contains
下一个
端接头
原始开发人员编写的代码期望系统使用。在这些系统上，将为汉字返回一个负整数。
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

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