Board logo

標題: [發問]以Byte為單位將字串予以做拆分，請問VBA要如何處理？ [打印本頁]
作者: Baracuda    時間: 2013-4-4 22:43     標題: [發問]以Byte為單位將字串予以做拆分，請問VBA要如何處理？

字串的長度是 120 個 Bytes
如果要每60個 Bytes 要做一個字串

測試字串如下，共為 120 個 Bytes
壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1

目的是要拆分成
壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1
壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1

但是用 VBA 寫出來會變成
壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1
陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1
壹1貳1參1四1伍1陸1七1捌1玖1拾1


VBA誤認為
60=15(中文字)*2+15(英文字也會變成2個Byte)*2
60=15(中文字)*2+15(英文字也會變成2個Byte)*2
40=10(中文字)*2+10(英文字也會變成2個Byte)*2

實際上 本人的認知是
45=15(中文字)*2+15*1
45=15(中文字)*2+15*1
30=10(中文字)*2+10*1
作者: Baracuda    時間: 2013-4-4 23:06

本帖最後由 Baracuda 於 2013-4-4 23:08 編輯
  1. Option Explicit
  2. Option Base 1
  3. Const Max_Length = 60

  5. Const Test_String = "壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1"
  6. ' 30  長度 "壹1貳1參1四1伍1陸1七1捌1玖1拾1"
  7. ' 120 長度 "壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1"

  9. Sub main()
  10.     Call Process_Over_Length_XX_Byte(Test_String)
  11. End Sub

  13. Sub Process_Over_Length_XX_Byte(Stg_Input As String)
  14. ' 將所輸入的字串，如果超過60個 Byte 後，予以分為 N列  , Max_Length =60
  15. Dim Total_Char_Byte As Integer, Total_Line_Output As Integer, i As Integer, CountDown_No As Integer
  16. Dim First_Max_Length_Stg As String, Tmp_Integer As Integer

  18.     Total_Char_Byte = LenB(Stg_Input)
  19.     Total_Line_Output = 1 + Int(Total_Char_Byte / Max_Length)
  20.     ' 總共有幾個 Line 要處理                   Max_Length = 60
  21.     CountDown_No = Total_Line_Output
  22.    
  23.     For i = 1 To Total_Line_Output
  24.         If CountDown_No = 1 Then
  25.         ' 如果是最後一列時，即是最後一次輸出
  26.             Debug.Print (Stg_Input)
  27.             Exit Sub
  28.         Else
  29.         ' 如果不是最後一列時，CountDown_No 的數字即減 1
  30.             CountDown_No = CountDown_No - 1
  31.             First_Max_Length_Stg = LeftB(Stg_Input, Max_Length) 'Max_Length = 60
  32.             Tmp_Integer = LenB(First_Max_Length_Stg)
  33.             Debug.Print First_Max_Length_Stg
  34.             Stg_Input = RightB(Stg_Input, LenB(Stg_Input) - Max_Length)
  35.             ' 將字串予以重置，去除前方60 個字元                              Max_Length = 60
  36.             Tmp_Integer = LenB(Stg_Input)
  37.         End If
  38.     Next i
  39. End Sub
複製代碼
Option Explicit
Option Base 1
Const Max_Length = 60

Const Test_String = "壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1"
' 30  長度 "壹1貳1參1四1伍1陸1七1捌1玖1拾1"
' 120 長度 "壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1壹1貳1參1四1伍1陸1七1捌1玖1拾1"

Sub main()
    Call Process_Over_Length_XX_Byte(Test_String)
End Sub

Sub Process_Over_Length_XX_Byte(Stg_Input As String)
' 將所輸入的字串，如果超過60個 Byte 後，予以分為 N列  , Max_Length =60
Dim Total_Char_Byte As Integer, Total_Line_Output As Integer, i As Integer, CountDown_No As Integer
Dim First_Max_Length_Stg As String, Tmp_Integer As Integer

    Total_Char_Byte = LenB(Stg_Input)
    Total_Line_Output = 1 + Int(Total_Char_Byte / Max_Length)
    ' 總共有幾個 Line 要處理                   Max_Length = 60
    CountDown_No = Total_Line_Output
   
    For i = 1 To Total_Line_Output
        If CountDown_No = 1 Then
        ' 如果是最後一列時，即是最後一次輸出
            Debug.Print (Stg_Input)
            Exit Sub
        Else
        ' 如果不是最後一列時，CountDown_No 的數字即減 1
            CountDown_No = CountDown_No - 1
            First_Max_Length_Stg = LeftB(Stg_Input, Max_Length) 'Max_Length = 60
            Tmp_Integer = LenB(First_Max_Length_Stg)
            Debug.Print First_Max_Length_Stg
            Stg_Input = RightB(Stg_Input, LenB(Stg_Input) - Max_Length)
            ' 將字串予以重置，去除前方60 個字元                              Max_Length = 60
            Tmp_Integer = LenB(Stg_Input)
        End If
    Next i
End Sub
作者: Baracuda    時間: 2013-4-4 23:07

附上程式內容以免有無法下載的問題
作者: Hsieh    時間: 2013-4-5 09:50

回復 3# Baracuda
最直接的方法是判斷字元碼來決定字元的位元數
  1. Sub ex()
  2. Dim k&, t%, i%, c%, s%
  3. k = Len(Test_String)
  4. t = 1
  5. Do Until i = k
  6.    Do Until s = Max_Length
  7.    i = i + 1
  8.    c = Asc(Mid(Test_String, i, 1))
  9.    s = s + IIf(c >= 0 And c <= 255, 1, 2) '判斷字元碼是否為ASCII,是則字元的位元數為1否則為2
  10.    Loop
  11.    MsgBox Mid(Test_String, t, i - t + 1)
  12.    t = i + 1
  13.    s = 0
  14. Loop
  15. End Sub
複製代碼
作者: Baracuda    時間: 2013-4-8 14:02

有測試過，邊界值會有問題

Bug 會產生的情況
要跨過 Max_Length 時，正好遇到中文or全型字。

Ex:
Max_Length=4
壹1貳1參1

壹1貳 實際是5個 Byte
Do Until s = Max_Length
因為如果
作者: Baracuda    時間: 2013-4-8 14:09

Hsieh 版主
這個跟我原來想的做法，方式大致相同。
想說看有無比較好的方法做。
這樣看來有些用「暴力」解題。
看來 VBA 也沒有其他函數比較好用。
[剛按的太快]
Ex:
Max_Length=4
壹1貳1參1

壹1貳 實際是5個 Byte
Do Until s = Max_Length
這樣會跨過一個字。

版主，這個 Bug 我想我可以自行解決。
如果有新的 VBA Defalult Function 的話，再告訴。
作者: Baracuda    時間: 2013-4-9 01:56

  1. Const Contatenate_Char = "_"
  2. Const Max_Length = 78
  3. '================================測試內容========================================================================
  4. 'Hsieh版主測試內容，會有 Bug
  5. '壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6
  6. '七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2


  9. '180="壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0"
  10. 'Max_Length = 78
  11. '壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸
  12. '_6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1貳2參3四4伍5陸6七7捌8玖9拾0壹1
  13. '_貳2參3四4伍5陸6七7捌8玖9拾0

  15. Sub main()
  16.         Call Process_Over_Length_XX(Test_String)
  17. End Sub

  19. Function If_ASCII_Stg(Stg_Test As String) As Boolean
  20. ' 測試字元碼是否為ASCII ，如果是 >= 0 且 <= 255 時，則為 ASCII
  21. ' 但是字元長度大於 1時，程式會抓第1個字元做判斷
  22.     If Asc(Stg_Test) >= 0 And Asc(Stg_Test) <= 255 Then
  23.         If_ASCII_Stg = True
  24.     Else
  25.         If_ASCII_Stg = False
  26.     End If
  27. End Function

  29. Sub Process_Over_Length_XX(Stg_Input As String)
  30. Dim Total_Pesudo_Char_Byte As Integer
  31. Dim Skip_1_or_2 As Byte, Current_Stg_Process_Position As Integer
  32. Dim Current_Stg As String, Ctr As Integer, Ctr_I As Integer
  33. Dim Counter_Stg_ProC_Bytes As Integer, Output_Stg As String
  34. Dim Line_1_Or_Not As Boolean
  35. Dim IS_ASCII_Boolean As Boolean

  37. ' 如果超過N個字時，就分前段的部分
  38. ' ==========   宣告字串總長度  & 字串現在處理的位置  ==========================
  39.     Total_Pesudo_Char_Byte = Len(Stg_Input): Ctr = 0: Ctr_I = 0             '先設定為空字串  & 為0
  40.     Current_Stg_Process_Position = 1: Current_Stg = "" '先設定為空字串  & 為0
  41.    
  42.     Do Until Ctr = Total_Pesudo_Char_Byte
  43.         Do Until Counter_Stg_ProC_Bytes >= Max_Length - 1 Or Ctr = Total_Pesudo_Char_Byte  ' 如果超過 Max Length 時，就要跳下一個字元
  44.             Ctr = Ctr + 1
  45.             Current_Stg = Mid(Test_String, Ctr, 1) ' 向前推進 1個字元
  46.             IS_ASCII_Boolean = If_ASCII_Stg(Current_Stg)
  47.             Skip_1_or_2 = IIf(IS_ASCII_Boolean, 1, 2)   ' 要 Skip 幾個 Byte  如果 字元碼是ASCII,則 跳過 位元數為1 否則為2
  48.             Counter_Stg_ProC_Bytes = Counter_Stg_ProC_Bytes + Skip_1_or_2
  49.             ' 現在在那一個 String Byte 的位置
  50.             If Counter_Stg_ProC_Bytes >= Max_Length And Not IS_ASCII_Boolean Then
  51.             ' 如果已是接近每行的 (最大數-1) 時，要注意是否有 正好遇到中文or全型字，使得加2後，會超過1個字。
  52.                 Counter_Stg_ProC_Bytes = Max_Length: Ctr = Ctr - 1     '退後1個字 強制跳出回圈，以處理的Byte 強制化為最大值
  53.             End If
  54.            
  55.         Loop
  56.         Output_Stg = Mid(Stg_Input, Current_Stg_Process_Position, Ctr - Current_Stg_Process_Position + 1)
  57.         Debug.Print (Output_Stg)
  58.         Current_Stg_Process_Position = Ctr + 1
  59.         Counter_Stg_ProC_Bytes = 0  ' 予以歸 0
  60.     Loop
  61. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)