如何用VBA分离如下中英文

vfd

谢谢大家，尤其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

vfd

以前收藏了本坛一个名家所写的一个函数，但只能处理纯粹的中文或英文或数字，对标点符号，不规范半角、全角字符处理不好，实用价值大打折扣。
Function MyGet(Srg As String, Optional n As Integer = False)  '从文本中过滤中文或英文或数字,格式为:   =myget(A2,1)

    Dim i As Integer
    Dim s, MyString As String
    Dim Bol As Boolean
   
    For i = 1 To Len(Srg)
        s = Mid(Srg, i, 1)
        If n = 1 Then
            Bol = Asc(s) < 0
        ElseIf n = 2 Then
            Bol = s Like "[a-z,A-Z]"
        ElseIf n = 0 Then
            Bol = s Like "#"
        End If
        If Bol Then MyString = MyString & s
    Next
   
    MyGet = IIf(n = 1 Or n = 2, MyString, Val(MyString))
   
End Function

leslie064

唉...为何没有理我的算法呢？我试做了一下，看能否满足你吧
for ii=1 to range("A65536").end(xlup).row
        aa=strconv(cells(ii,1),vbnarrow)
jum_pos:
        for jj=1 to len(aa)
                str_ascii=asc(mid(aa,jj,1))
                if str_ascii<0 or str_ascii>256 then
                        aa= Left(aa, jj - 1) + Right(aa, Len(aa) - jj)
                        goto jump_pos
                endif
        next jj
        cells(ii,2)=trim(aa)
next ii

alzeng

原帖由 vfd 于 2009-7-17 14:22 发表
谢谢大家，尤其alzeng，收藏了。但我基础较差，不明白如何实现的，只好慢慢琢磨。

照我的看法，是按"　　"，就是原文和翻译之间的空格分离，但只要改变这个空格大小，就失效了。不对之处，请大家指教。
Private  ...

依我的感觉，你这些数据应该是从网页上取下来的，原数据应该是遵循了一定的规则的。
其实，即使是不依这个空格作条件，用查找汉字的方法界定也不是太麻烦的事，^_^

vfd

原帖由 leslie064 于 2009-7-17 16:17 发表
唉...为何没有理我的算法呢？我试做了一下，看能否满足你吧
for ii=1 to range("A65536").end(xlup).row
        aa=strconv(cells(ii,1),vbnarrow)
jum_pos:
        for jj=1 to len(aa)
                str_ascii=asc(mid(aa,jj,1))
                 ...

首先不是我不用，而是我不懂如何用你的东西，其次我估计你这种算法对标点符号之类还是处理不好，抱歉，水平有限。

yanjie

我能处理这个问题，而且是随心所欲，你想要保留标点符号也可，不保留也可！
你可以把文件发给我，我帮你处理好之后，返回给你！
邮箱yanjieeee@sina.com

yanjie

只作了一部分
yanjie.rar (7.26 KB, 下载次数: 23)

2009-7-18 15:27 上传

点击文件名下载附件

vfd

原帖由 yanjie 于 2009-7-18 15:27 发表
只作了一部分
550672

不好意思，你误会了，所以结论不正确。

yanjie

是不正确，我知道。
我只把13笔画以上的汉字显示出来，实际上，只要给我2小时时间，我把所有汉字粘贴进代码中，就能完成！
包括标点符号，甚至半角或者全角符号，都能做到！简体汉字有7000个左右！

unsamesky

Sub Test()
'本方法不支持汉字和字母的混合分离！只支持汉字段和字母段的分离！尚未详细测试！
  Dim capStr As String
  capStr = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  
  Dim i As Long '行循环时用
  Dim rw As Long '存储A列最后一行的行数
  Dim rng As Range '循环存储a列每个单元格
  Dim ss As Integer '存贮第一个字母所在的位置
  Dim ee As Integer '存储第一个汉字所在的位置
  Dim m As Integer  '依次提取A列单元格中每个自符要用到的循环变量
  
  rw = [A65536].End(3).Row
  For i = 1 To rw
  On Error Resume Next
    Set rng = Cells(i, 1)
    ss = 0
    ee = 0
    For m = 1 To Len(rng)
      If ss > 0 Then GoTo Findee '只存储第一个字母的位置
      If InStr(capStr, Mid(rng, m, 1)) > 0 Then ss = m '找第一个字母所在的位置
      
Findee:
      If ee > 0 Then GoTo Findss '只存储第一个汉字的位置！
      If Asc(Mid(rng, m, 1)) < 0 Then ee = m '找第一个汉字所在的位置
Findss:
      If ss > 0 And ee > 0 Then Exit For
    Next
   
    If ss > ee Then c = ss: ss = ee: ee = c
    rng.Offset(0, 1) = Mid(rng, ss, ee - ss)
    rng.Offset(0, 2) = Mid(rng, ee, Len(rng) - ee + 1)

  Next
  Set rng = Nothing
End Sub