准提部林

回復 20# lionliu


範例檔的〔函數〕或〔VBA〕兩法，都有中文字〔掉字〕問題，
＃１５程式稍修如下：
Sub 截取字串()
Dim Arr
Arr = SPT_Str(Replace([A2], Chr(10), ""), 20)　
Arr = Split(Arr, Chr(10))
[B6].Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
End Sub

〔自訂函數〕Function SPT_Str(xString$, xLength%)　不變！

完全不會有〔掉字／差字〕問題～～～

lionliu

回復 21# 准提部林
謝謝准大
幫我把這困擾我很久的問題解決了
，我再仔細的研究一定要搞懂他。

ML089

回復 20# lionliu
原始備註是以CHAR(13)&CHAR(10)結尾，若要重新分隔為20字元時，CHAR(13)&CHAR(10)結尾用 "," 來替代會比好。

下載 (213.21 KB)

2016-1-22 23:55

一、採用函數公式方法
名稱公式
find_text =MIDB(STR,LOOKUP(999,IF({1,0},1,FINDB(INDIRECT("R[-1]C",),STR)+LENB(INDIRECT("R[-1]C",)))),{19;20})
STR =SUBSTITUTE(!$A$2,CHAR(13)&CHAR(10),",")

C6公式
C6 =IF(AND(ROW(A1)>1,INDIRECT("R[-1]C",)=""),"",LOOKUP(,0/FINDB(find_text,STR),find_text))

公式其他應用時需要修改 名稱中的 $A$2，其他不需要處理。


二、採用VBA方法
借用准大的VBA修改如下

Sub 截取字串()
    Dim Arr
    Arr = SPL(Replace([A2], Chr(13) & Chr(10), ","), 20)
    Arr = Split(Arr, Chr(10))
    [H6].Resize(UBound(Arr)) = Application.Transpose(Arr)
End Sub

Function SPL(ByVal xS$, xL%)
    If xS = "" Then Exit Function
    nL = IIf(InStr(xS, xMidB(xS, 1, 20)), 20, 19)
    SPL = xMidB(xS, 1, nL) & Chr(10) & SPL(xMidB(xS, nL + 1, 9999), xL) '遞回處理
End Function

Function xMidB(ByVal str As String, start, length) As String
    xMidB = StrConv(MidB(StrConv(str, vbFromUnicode), start, length), vbUnicode)
End Function

Function xLenB(ByVal str As String)
    xLenB = LenB(StrConv(str, vbFromUnicode))
End Function

三、採用自訂函數及自動換列方式
=SPL(SUBSTITUTE($A$2,CHAR(13)&CHAR(10),","),20)

lionliu

回復 23# ML089
謝謝ml版他大的提醒， 讓我的資料內榮更通順。我再仔細的研究一下。