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

帖子: 132
主題: 25
精華: 0
積分: 199
點名: 0
作業系統: window XP
軟體版本: Excel 2010
閱讀權限: 20
性別: 男
來自: 台灣新竹
註冊時間: 2010-6-1
最後登錄: 2022-7-14

2013蛇年全勤獎章論壇榮譽勳章論壇贊助勳章

2^#

發表於 2013-4-4 23:06 | 只看該作者

本帖最後由 Baracuda 於 2013-4-4 23:08 編輯

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

複製代碼

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

帖子: 132
主題: 25
精華: 0
積分: 199
點名: 0
作業系統: window XP
軟體版本: Excel 2010
閱讀權限: 20
性別: 男
來自: 台灣新竹
註冊時間: 2010-6-1
最後登錄: 2022-7-14

2013蛇年全勤獎章論壇榮譽勳章論壇贊助勳章

3^#

發表於 2013-4-4 23:07 | 只看該作者

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

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 255
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-25

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2013-4-5 09:50 | 只看該作者

回復 3# Baracuda
最直接的方法是判斷字元碼來決定字元的位元數

Sub ex()
Dim k&, t%, i%, c%, s%
k = Len(Test_String)
t = 1
Do Until i = k
Do Until s = Max_Length
i = i + 1
c = Asc(Mid(Test_String, i, 1))
s = s + IIf(c >= 0 And c <= 255, 1, 2) '判斷字元碼是否為ASCII,是則字元的位元數為1否則為2
Loop
MsgBox Mid(Test_String, t, i - t + 1)
t = i + 1
s = 0
Loop
End Sub

複製代碼

學海無涯_不恥下問

帖子: 132
主題: 25
精華: 0
積分: 199
點名: 0
作業系統: window XP
軟體版本: Excel 2010
閱讀權限: 20
性別: 男
來自: 台灣新竹
註冊時間: 2010-6-1
最後登錄: 2022-7-14

2013蛇年全勤獎章論壇榮譽勳章論壇贊助勳章

5^#

發表於 2013-4-8 14:02 | 只看該作者

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

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

Ex:
Max_Length=4
壹1貳1參1

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

帖子: 132
主題: 25
精華: 0
積分: 199
點名: 0
作業系統: window XP
軟體版本: Excel 2010
閱讀權限: 20
性別: 男
來自: 台灣新竹
註冊時間: 2010-6-1
最後登錄: 2022-7-14

2013蛇年全勤獎章論壇榮譽勳章論壇贊助勳章

6^#

發表於 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 的話，再告訴。

帖子: 132
主題: 25
精華: 0
積分: 199
點名: 0
作業系統: window XP
軟體版本: Excel 2010
閱讀權限: 20
性別: 男
來自: 台灣新竹
註冊時間: 2010-6-1
最後登錄: 2022-7-14

2013蛇年全勤獎章論壇榮譽勳章論壇贊助勳章

7^#

發表於 2013-4-9 01:56 | 只看該作者

Const Contatenate_Char = "_"
Const Max_Length = 78
'================================測試內容========================================================================
'Hsieh版主測試內容，會有 Bug
'壹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
'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"
'Max_Length = 78
'壹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
Sub main()
Call Process_Over_Length_XX(Test_String)
End Sub
Function If_ASCII_Stg(Stg_Test As String) As Boolean
' 測試字元碼是否為ASCII ，如果是 >= 0 且 <= 255 時，則為 ASCII
' 但是字元長度大於 1時，程式會抓第1個字元做判斷
If Asc(Stg_Test) >= 0 And Asc(Stg_Test) <= 255 Then
If_ASCII_Stg = True
Else
If_ASCII_Stg = False
End If
End Function
Sub Process_Over_Length_XX(Stg_Input As String)
Dim Total_Pesudo_Char_Byte As Integer
Dim Skip_1_or_2 As Byte, Current_Stg_Process_Position As Integer
Dim Current_Stg As String, Ctr As Integer, Ctr_I As Integer
Dim Counter_Stg_ProC_Bytes As Integer, Output_Stg As String
Dim Line_1_Or_Not As Boolean
Dim IS_ASCII_Boolean As Boolean
' 如果超過N個字時，就分前段的部分
' ========== 宣告字串總長度 & 字串現在處理的位置 ==========================
Total_Pesudo_Char_Byte = Len(Stg_Input): Ctr = 0: Ctr_I = 0 '先設定為空字串 & 為0
Current_Stg_Process_Position = 1: Current_Stg = "" '先設定為空字串 & 為0
Do Until Ctr = Total_Pesudo_Char_Byte
Do Until Counter_Stg_ProC_Bytes >= Max_Length - 1 Or Ctr = Total_Pesudo_Char_Byte ' 如果超過 Max Length 時，就要跳下一個字元
Ctr = Ctr + 1
Current_Stg = Mid(Test_String, Ctr, 1) ' 向前推進 1個字元
IS_ASCII_Boolean = If_ASCII_Stg(Current_Stg)
Skip_1_or_2 = IIf(IS_ASCII_Boolean, 1, 2) ' 要 Skip 幾個 Byte 如果字元碼是ASCII,則跳過位元數為1 否則為2
Counter_Stg_ProC_Bytes = Counter_Stg_ProC_Bytes + Skip_1_or_2
' 現在在那一個 String Byte 的位置
If Counter_Stg_ProC_Bytes >= Max_Length And Not IS_ASCII_Boolean Then
' 如果已是接近每行的 (最大數-1) 時，要注意是否有正好遇到中文or全型字，使得加2後，會超過1個字。
Counter_Stg_ProC_Bytes = Max_Length: Ctr = Ctr - 1 '退後1個字強制跳出回圈，以處理的Byte 強制化為最大值
End If
Loop
Output_Stg = Mid(Stg_Input, Current_Stg_Process_Position, Ctr - Current_Stg_Process_Position + 1)
Debug.Print (Output_Stg)
Current_Stg_Process_Position = Ctr + 1
Counter_Stg_ProC_Bytes = 0 ' 予以歸 0
Loop
End Sub

複製代碼