[發問]以Byte為單位將字串予以做拆分，請問VBA要如何處理？

Baracuda

字串的長度是 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

1. Option Explicit
   
2. Option Base 1
   
3. Const Max_Length = 60
   
4. 
   
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"
   
8. 
   
9. Sub main()
   
10.     Call Process_Over_Length_XX_Byte(Test_String)
    
11. End Sub
    
12. 
    
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
    
17. 
    
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

附上程式內容以免有無法下載的問題

Hsieh

回復 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

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

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

Ex:
Max_Length=4
壹1貳1參1

壹1貳 實際是5個 Byte
Do Until s = Max_Length
因為如果

Baracuda

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

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

版主，這個 Bug 我想我可以自行解決。
如果有新的 VBA Defalult Function 的話，再告訴。

Baracuda

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
   
7. 
   
8. 
   
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
    
14. 
    
15. Sub main()
    
16.         Call Process_Over_Length_XX(Test_String)
    
17. End Sub
    
18. 
    
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
    
28. 
    
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
    
36. 
    
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

複製代碼