Office中国论坛/Access中国论坛

标题: 【已解决】如何将字符串按定长字节分割成多个字符串？ [打印本页]
作者: 玉树TMD临风    时间: 2014-4-25 21:57
标题: 【已解决】如何将字符串按定长字节分割成多个字符串？
本帖最后由 玉树TMD临风 于 2014-4-26 11:36 编辑

有个字符串A，里面有中、英文，中文算2个字符，英文算一个字节。

现在想将字符串按字节分割，用"\"隔开，如果分割处刚好是个汉字各占一半，那这个汉字就算到下个分割后的字符串，缺的那个字节用空格顶上。

比如：
字符串A="我1人2年吃了3斤油“，要求按3个字节分割。

正确结果是：“我1\人2\年 \吃 \了3\斤 \油 "，因为”我“的字节长度是2,”1“的字节长度是1，加起来刚好是3，以此类推。。。

这个看起来简单，可我弄了2天没弄好，特来求助。

已搞定，谢谢各位，附上源码：

Function test(zf As Variant, n As Integer)

On Error Resume Next        '当N为某此数值时，下面的I+1会超出字符长度而报错

Dim tmp As String

Dim m As Integer, i As Integer

For i = 1 To Len(zf)

tmp = tmp & Mid(zf, i, 1)

Select Case Asc(Mid(zf, i, 1))

Case Is > 0

a = a + 1           '英文字符

Case Else

a = a + 2           '中文字符

End Select

If a = n Then test = test & tmp & "\": tmp = "": a = 0

If a = n - 1 Then If Asc(Mid(zf, i + 1, 1)) < 0 Then test = test & tmp & " \": tmp = "": a = 0

If i = Len(zf) And a < n - 1 And a <> 0 Then test = test & tmp & Space(n - a) & "\": a = 0
'
最后一段如果不够字节长度N时

Next i

End Function


作者: qjiangxi    时间: 2014-4-25 22:38
试一下这个，好像还有一点小问题，麻烦你自己测试了
  1. Public Function test(oldTXT As String) As String
  2.     Dim newTXT As String
  3.     Dim x As Integer, y As Integer
  4.     x = Len(oldTXT)
  5.     y = 1
  6.     Do Until y > x
  7.         If Mid(oldTXT, y, 1) Like "[a-z,0-9]" Then
  8.             newTXT = newTXT & Mid(oldTXT, y, 1) & ""
  9.             y = y + 1
  10.         Else
  11.             If Mid(oldTXT, y + 1, 1) Like "[a-z,0-9]" Then
  12.                 newTXT = newTXT & Mid(oldTXT, y, 2) & ""
  13.                 y = y + 2
  14.             Else
  15.                 newTXT = newTXT & Mid(oldTXT, y, 1) & " "
  16.                 y = y + 1
  17.             End If
  18.         End If
  19.     Loop
  20.     test = newTXT
  21. End Function
复制代码

  1. ?test("1我a人2年吃了3斤油")
  2. 1\我a\人2\年 \吃 \了3\斤 \油 \
复制代码
作者: 玉树TMD临风    时间: 2014-4-25 22:47
谢谢，回头试试，还需要个定长数字变量
作者: qjiangxi    时间: 2014-4-25 22:56
  1. Public Function test(oldTXT As String) As String
  2.     Dim newTXT As String
  3.     Dim x As Integer, y As Integer
  4.     x = Len(oldTXT)
  5.     y = 1
  6.     Do Until y > x
  7.         If Mid(oldTXT, y, 1) Like "[a-z,0-9]" Then
  8.             newTXT = newTXT & Mid(oldTXT, y, 1)
  9.             y = y + 1
  10.             If Mid(oldTXT, y, 1) Like "[a-z,0-9]" Then
  11.                 newTXT = newTXT & Mid(oldTXT, y, 1)
  12.                 y = y + 1
  13.                 If Mid(oldTXT, y, 1) Like "[a-z,0-9]" Then
  14.                     newTXT = newTXT & Mid(oldTXT, y, 1) & ""
  15.                     y = y + 1
  16.                 Else
  17.                     newTXT = newTXT & " "
  18.                 End If
  19.             Else
  20.                 newTXT = newTXT & Mid(oldTXT, y, 1) & ""
  21.                 y = y + 1
  22.             End If
  23.         Else
  24.             If Mid(oldTXT, y + 1, 1) Like "[a-z,0-9]" Then
  25.                 newTXT = newTXT & Mid(oldTXT, y, 2) & ""
  26.                 y = y + 2
  27.             Else
  28.                 newTXT = newTXT & Mid(oldTXT, y, 1) & " "
  29.                 y = y + 1
  30.             End If
  31.         End If
  32.     Loop
  33.     test = newTXT
  34. End Function
复制代码

  1. ?test("11我a人2年吃了3斤油")
  2. 11 \我a\人2\年 \吃 \了3\斤 \油 \
  3. ?test("我a人2年吃了3斤油")
  4. 我a\人2\年 \吃 \了3\斤 \油 \
  5. ?test("1我a人2年吃了3斤油")
  6. 1我\a人\2年\吃 \了3\斤 \油 \
复制代码
作者: andymark    时间: 2014-4-26 00:20
  1. <p>Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long</p><p>
  2. Function Test(strText) As String
  3.   Dim str As String
  4.   Dim temstr As String
  5.   Dim s As String
  6.   Dim k As String
  7.   Dim n As Integer
  8.   Dim m As Integer
  9.   Dim i As Integer
  10. ' str = "他1a1我1a人2年吃了3斤油2你"
  11.   For i = 1 To Len(strText)
  12.      temstr = Mid(strText, i, 1)
  13.      n = lstrlen(temstr + Chr(0))
  14.      m = m + n
  15.      If m > 3 Then
  16.        k = k & s & ""
  17.        s = temstr
  18.        m = n
  19.      Else
  20.       s = s & temstr
  21.     End If
  22.   Next
  23.   
  24. If Len(s) > 0 Then
  25.    k = k & s & ""
  26. End If
  27. Test = k
  28. End Function
  29. </p><p>
  30. </p><p>Debug.Print Test("玉1树1临1,风aTMD,人2年吃了3斤油2你")</p><p>返回：玉1\树1\临1\,风\aTM\D,\人2\年\吃\了3\斤\油2\你\
  31. </p>
复制代码
作者: andymark    时间: 2014-4-26 00:23
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long


Function Test(strText) As String
  Dim str As String
  Dim temstr As String
  Dim s As String
  Dim k As String
  Dim n As Integer
  Dim m As Integer
  Dim i As Integer
' str = "他1a1我1a人2年吃了3斤油2你"
  For i = 1 To Len(strText)
     temstr = Mid(strText, i, 1)
     n = lstrlen(temstr + Chr(0))
     m = m + n
     If m > 3 Then
       k = k & s & "\"
       s = temstr
       m = n
     Else
      s = s & temstr
    End If
  Next
  
If Len(s) > 0 Then
   k = k & s & "\"
End If
Test = k
End Function
作者: andymark    时间: 2014-4-26 00:24
记得引用API
作者: 玉树TMD临风    时间: 2014-4-26 01:52
谢谢楼上各位，明天测试后回复大家！
作者: 玉树TMD临风    时间: 2014-4-26 01:53
谢谢各位，明天试试
作者: zhuyiwen    时间: 2014-4-26 08:53
有意思的题目，呵呵
作者: 玉树TMD临风    时间: 2014-4-26 09:37
zhuyiwen 发表于 2014-4-26 08:53
有意思的题目，呵呵

朱总有空指点一下啊。上面的示例一是没有加“字节长度”的参数，这个我可以修改；二是不足字节长度的没有加" "空格补齐，代码里一时看不出来在哪里加。
作者: 玉树TMD临风    时间: 2014-4-26 09:42
qjiangxi 发表于 2014-4-25 22:56

谢谢！可用。我先按这思路修改一下可按字节长度变量进行分割的函数
作者: 玉树TMD临风    时间: 2014-4-26 11:33
搞了一上午终于搞定了，附上源代码：

Function test(zf As Variant, n As Integer)
On Error Resume Next        '当N为奇数时
Dim tmp As String
Dim m As Integer, i As Integer
For i = 1 To Len(zf)
tmp = tmp & Mid(zf, i, 1)
Select Case Asc(Mid(zf, i, 1))
Case Is > 0
a = a + 1           '英文字符
Case Else
a = a + 2           '中文字符
End Select
If a = n Then test = test & tmp & "\": tmp = "": a = 0
If a = n - 1 Then If Asc(Mid(zf, i + 1, 1)) < 0 Then test = test & tmp & " \": tmp = "": a = 0
If i = Len(zf) And a < n - 1 And a <> 0 Then test = test & tmp & Space(n - a) & "\": a = 0   '最后一段如果不够字节长度N时
Next i
End Function

谢谢楼上各位，如果有更简单的办法可继续讨论

作者: wang1999    时间: 2014-4-26 13:23
本帖最后由 wang1999 于 2014-4-26 15:01 编辑

前天听完课后，答应你回复你，可一直太忙，今天刚只有一点空，先给出代码给你。有空再深入分析吧
核心是计算中文字节长度，在VB5时代直接可以用LEN函数即可，可UNICODE就不同了。
目前我知道方法有4种，核心代码如下

算法一利用StrConv(比算法二快9倍)
'-----------------------------------------------------------------
Public Function LenEx(VarString As Variant) As Variant
'算法一
    LenEx = LenB(StrConv(VarString, vbFromUnicode))    '将Unicode转换为ANSI,然后再计算字节长度
End Function
''算法二
'Public Function LenEx1(VarString As Variant) As Variant
'    Dim lLen As Integer, i As Integer
'    LenEx1 = 0
'    lLen = Len(VarString)
'    If lLen Then                              '如长度不为零
'        For i = 1 To lLen
'            If Asc(Mid(VarString, i, 1)) < 0 Then
'                LenEx1 = LenEx1 + 2
'            Else
'                LenEx1 = LenEx1 + 1
'            End If
'        Next
'    End If
'End Function

方法四，利用 lstrlenA 函数, 等于利用VB的后台U/A转换，效率跟StrConv差不多。
作者: wang1999    时间: 2014-4-26 14:03
还有没有更快的方法呢，看着StrConv要进行一次转换真不爽！
再写一个
作者: 玉树TMD临风    时间: 2014-4-26 14:26
wang1999 发表于 2014-4-26 14:03
还有没有更快的方法呢，看着StrConv要进行一次转换真不爽！
再写一个

转换成字节问题不大，用下面这个就可以了，现在遇到新问题，开新贴问。
For i = 1 To Len(zf)
Select Case Asc(Mid(zf, i, 1))
Case Is > 0
a = a + 1           '英文字符
Case Else
a = a + 2           '中文字符
End Select
作者: wang1999    时间: 2014-4-26 14:28
'算法三     直接操作对比Unicode码
Function LenDB(Str As String) As Long
    Dim i As Long, lngLenB As Long
    Dim abytStr() As Byte
    Const DoubleByte As Byte = &H30
    abytStr = Str
    lngLenB = LenB(Str)
    For i = 1& To lngLenB Step 2&
        If abytStr(i) < DoubleByte Then
            lngLenB = lngLenB - 1&
        End If
    Next
    LenDB = lngLenB
End Function

算法三应该甩开算法StrConv几条街了
作者: wang1999    时间: 2014-4-26 14:38
玉树TMD临风 发表于 2014-4-26 14:26
转换成字节问题不大，用下面这个就可以了，现在遇到新问题，开新贴问。
For i = 1 To Len(zf)
Select  ...

这个算法有些情况下是有问题的
用你的这个算法试试下面的字符串
    Str = "ΑΒΓαβγ" '希腊字符


作者: 玉树TMD临风    时间: 2014-4-26 14:59
wang1999 发表于 2014-4-26 14:38
这个算法有些情况下是有问题的
用你的这个算法试试下面的字符串
    Str = "ΑΒΓαβγ" '希腊字符

我这代码算出来是12，应该是多少？
作者: 玉树TMD临风    时间: 2014-4-26 15:03
wang1999 发表于 2014-4-26 14:38
这个算法有些情况下是有问题的
用你的这个算法试试下面的字符串
    Str = "ΑΒΓαβγ" '希腊字符

不过我的代码把所有英文字符以外的都算双字节，你这些字母我也不知道是单还是双，所以用我的代码是按双字节算出来的
作者: wang1999    时间: 2014-4-26 15:11
我不是提供了四个方法，你都 试试，
目前最完美的解决方案是，算法3了，不管准确度还是速度，你就直接用这个。

其实判定单双字节，本身就不是个很严谨的问题（因为它与你的字体有一定关系），只不过在一些特定环境却有一定用处。



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3