如何用VBA分离如下中英文

vfd

在翻译当中经常要整理句库，这就涉及到如何分离中英文。在搜索完本论坛解决方案后，还是没有发现好的VBA解决方案。请高手帮忙解决。

示例：A1=1． Good to the last drop．　　滴滴香浓，意犹未尽。（麦斯威尔咖啡）
分离结果：B1=Good to the last drop．        C1=滴滴香浓，意犹未尽。（麦斯威尔咖啡）

具体内容参考附件。


首先谢谢大家！如果你有好的解决方案不妨直接与我联系，我的联系方式是：
QQ=1310088
vfdat@126.com

谢谢大家，尤其alzeng，收藏了。但我基础较差，不明白如何实现的，只好慢慢琢磨。

照我的看法，是按"　　"，就是原文和翻译之间的空格分离，但只要改变这个空格大小，就失效了。不对之处，请大家指教。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range, str$, i%

    For Each rng In Range("A1", [A65536].End(3))
        str = Split(rng, "　　")(0)
        i = 0
        Do While IsNumeric(Left(str, i + 1))
            i = i + 1
        Loop

        rng.Offset(, 1) = LTrim(Right(str, Len(str) - i))
        rng.Offset(, 2) = LTrim(Split(rng, "　　")(1))
    Next

End Sub

再次谢谢alzeng，他在后面提供的下面这段代码好极了，很完美地实现了我的要求，供大家参考。

Sub splt()
    Dim rng As Range, stg$, str$, i%, j%

    For Each rng In Range("A1", [A65536].End(3))
        stg = rng
        i = 1
        Do Until Mid(stg, i, 1) Like "*[一-龥]*"
            i = i + 1
        Loop
        
        str = Left(stg, i - 1)
        j = 0
        Do While IsNumeric(Left(str, j + 1))
            j = j + 1
        Loop

        rng.Offset(, 1) = Trim(Right(str, Len(str) - j))
        rng.Offset(, 2) = Trim(Right(stg, Len(stg) - i))
    Next
End Sub


根据最新的增补和修改，一个比较通用的代码如下，根据alzeng提供的代码，我斗胆做了注释，不对之处，还请alzeng指正。再次谢谢alzeng和其他付出劳动的高手。
代码如下：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rng As Range, stg$, str$, i%, j%, k%

    For Each rng In Range("A1", [A65536].End(3))
        stg = rng

        k = 1
        Do Until Mid(stg, k + 1, 1) Like "*[a-z,A-Z]*"
            k = k + 1
        Loop
'找英文的位置K
        i = 1
        Do Until Mid(stg, i + 1, 1) Like "*[一-龥]*"
            i = i + 1
        Loop
'找中文的位置I
        If i < k Then i = k               '如果中文在前，两者的位置一样
        str = VBA.Left(stg, i) '中英文分离位置前一位字符(i - 1),修改为直接取I，发现中文在前会少取最后一个中文。
        j = 0
        Do While IsNumeric(Left(str, j + 1))
            j = j + 1
        Loop
'找数字所占位数J
        rng.Offset(, 2) = Trim(Right(stg, Len(stg) - i))
        rng.Offset(, 1) = Trim(Right(str, Len(str) - j))
    Next

End Sub


结果请参考分离完整版.rar
2009.07.24

[ 本帖最后由 vfd 于 2009-7-24 08:58 编辑 ]

tonyibm

用正则表达式，

yongjian27

Function GetMyString(MyValue As Range) '提取英文及数字、排除中文字
   
    Application.Volatile
        For i = 1 To Len(MyValue)
            If Asc(Mid(MyValue, i, 1)) > 0 Then
                MyString = MyString & Mid(MyValue, i, 1)
            End If
        Next
    GetMyString = MyString
    End Function

Function getchn(MyValue As Range)'提取中文

Dim i As Integer

Dim chn As String

For i = 1 To Len(MyValue)

If Asc(Mid(MyValue, i, 1)) < 0 Then

chn = chn & Mid(MyValue, i, 1)

End If

Next

getchn = chn


End Function

[ 本帖最后由 yongjian27 于 2009-7-15 17:04 编辑 ]

fsyyyy

Private Sub fsyyyy()
    For i = 1 To 20
        a = Me.Cells(i, 1)
        fa = InStr(a, "．")
        If fa = 0 Then fa = InStr(a, ".")
        fb = InStrRev(a, "．")
        If fb = 0 Then fb = InStrRev(a, ".")
        Me.Cells(i, 2) = Trim(Mid(a, fa + 1, fb))
        Me.Cells(i, 3) = Trim(Mid(a, fb + 1))
    Next
End Sub

提示：
请注意"．"与"."的不同，全角和半角

leslie064

你的需求很像是市场研究公司DP经常遇到的问题，我的做法是先把单元格所有字符变成单字符格式，然后用循环加ASC判别是否在ASCII编码内，如果是中文的话，在单字符格式转换时会乱码，是不符合的ASCII的，之后就不用说啦

yongjian27

原帖由 yongjian27 于 2009-7-15 16:55 发表
Function GetMyString(MyValue As Range) '提取英文及数字、排除中文字
   
    Application.Volatile
        For i = 1 To Len(MyValue)
            If Asc(Mid(MyValue, i, 1)) > 0 Then
                M ...

这个可以分离,但是就是前面的数字没去掉
忘了这是哪位朋友的杰作了,借花献佛了

leslie064

6楼的程序差了两步，getmystring是自定义的函数，首先应该用StrConv函数把单元格里的字符变成单字符的，如（aa = StrConv(aa, vbNarrow)），然后用你的循环用ASC函数判别是否在0-255之间，如下：
str_asc = Asc(Mid(aa, ii, 1))
If str_asc < 0 Or str_asc > 256 Then　aa = Left(aa, ii - 1) + Right(aa, Len(aa) - ii)

tonyibm

正则表达式，
楼主的附件有个问题，要求说是分离中文与英文，但是在中文部分，其实是夹杂有英文的，如果IBM公司的那一条，分离后，中文部分的括号内就只剩下公司了，IBM这三个字母就被滤掉了，而其英文部分的后面就是以IBM结尾的，所以楼主的附件还是不太规范，

Sub aa()

Dim x, z As Integer
Dim regex As RegExp
Dim strng As String
Dim matches As MatchCollection
Dim patrn As String
Dim result As String

Set regex = New RegExp
regex.IgnoreCase = False
regex.Global = True
   
For z = 1 To [a65536].End(xlUp).Row

    strng = Cells(z, 1)
    patrn = "[A-Za-z ]"
    regex.Pattern = patrn
   
    Set matches = regex.Execute(strng)
   
    For x = 0 To matches.Count - 1
   
        result = result & matches.Item(x)
        
    Next x
   
    Cells(z, 2) = result
   
    result = ""
   
Next z

result = ""

For z = 1 To [a65536].End(xlUp).Row
   
    strng = Cells(z, 1)
    patrn = "[一-龥，。——（）]"
    regex.Pattern = patrn

    Set matches = regex.Execute(strng)
   
    For x = 0 To matches.Count - 1
   
        result = result & matches.Item(x)
        
    Next x
   
    Cells(z, 3) = result
   
    result = ""
   
Next z

End Sub

[ 本帖最后由 tonyibm 于 2009-7-15 17:23 编辑 ]

alzeng

这么有规律，就用Split吧。
英汉分离.rar (7.72 KB, 下载次数: 81)

2009-7-15 17:42 上传

点击文件名下载附件

alzeng

改进一下，去掉条目数字：

1. 
   
2. Sub splt()
   
3.     Dim rng As Range, str$, i%
   
4. 
   
5.     For Each rng In Range("A1", [A65536].End(3))
   
6.         str = Split(rng, "　　")(0)
   
7.         i = 0
   
8.         Do While IsNumeric(Left(str, i + 1))
   
9.             i = i + 1
   
10.         Loop
    
11. 
    
12.         rng.Offset(, 1) = LTrim(Right(str, Len(str) - i))
    
13.         rng.Offset(, 2) = LTrim(Split(rng, "　　")(1))
    
14.     Next
    
15. End Sub
    

复制代码