Board logo

標題: 大筆資料換行處理與數字文字分隔問題 [打印本頁]
作者: greetingsfromtw    時間: 2016-10-8 21:14     標題: 大筆資料換行處理與數字文字分隔問題

各位前輩好,

小弟目前遇到一個問題,

附上檔案連結:
點擊下載

檔案說明如下:
A欄的資料格式為示意,實際上有非常多筆,
資料格式為文字+數字
(文字全部打"文字"僅為示意文字部份之用,資料的文字內容各不相同,不是說資料真的都是以"文字"開頭加數字)
,文字和數字的長度均不固定.
文字+數字視為一筆資料,
不同筆資料之間以空格或換行隔開,比如說三筆資料,
那就是文字+數字 文字+數字 文字+數字,
空格也有可能是換行.
希望達到的效果是把A欄所有的資料的文字部份與數字部份區隔開來,
放在儲存格內.

文字放在F欄,

數字的部份,

若數字開頭不是1,則放在G欄,並且在數字開頭加上G1儲存格內填入的數字.

G1由使用者手動輸入,若為空白,則數字開頭不加任何數字,直接放在G欄.

若數字開頭為1,則直接將數字不做任何修改放在I欄.


目前的這個檔案可以達到類似效果,

但有以下缺點:

1.無法刪除重複號碼.希望可以有比對並刪除重複號碼的效果.

2.運算過慢.因為採用巨集與公式合併的方式,
把A欄不同筆資料做換行處理並貼至E欄的程式碼是在網路上詢問高手時得到的答案,
我只是轉貼過來用而已,這部份其實在運作上沒有問題.

將數字與文字分開,則是我從網路上查找到的高手所寫的公式,
把它套過來使用,

但是我只把公式下拉了五百多筆,
光是這樣子運算就很花時間,所以這個檔案無法處理大量的資料,

不知是否有前輩願意指點該如何改成全部巨集的版本,
提高它的運算速度並讓它可處理大量的資料,

十分感謝.
作者: 准提部林    時間: 2016-10-9 11:46

  1. Sub Test()
  2. Dim A, B, T$, Brr(1 To 6000, 1 To 4), xD, N&, u, v
  3. [F2:I6000].ClearContents
  4. Set xD = CreateObject("Scripting.Dictionary")
  5. For Each A In Range([A2], [A65536].End(xlUp)).Value
  6. For Each B In Split(Replace(A, Chr(10), " "), " ")
  7.     For i = 1 To Len(B) + 1
  8.         If Not IsNumeric(Right("x" & B, i)) Then v = i - 1: Exit For
  9.     Next
  10.     If v = 0 Then GoTo 101
  11.     T = Right(B, v): If xD(T) > 0 Then GoTo 101
  12.     u = 4: If Left(T, 1) = "1" Then u = 2: T = [G1] & T
  13.     N = N + 1: Brr(N, 1) = Left(B, Len(B) - v): Brr(N, u) = T
  14.     xD(T) = 1: v = 0
  15. 101: Next
  16. Next
  17. If N > 0 Then [F2].Resize(N, 4) = Brr
  18. End Sub
複製代碼
[attach]25500[/attach]
作者: greetingsfromtw    時間: 2016-10-9 14:38

回復 2# 准提部林


非常感謝淮提部林前輩熱心無私提供程式碼,

可能是小弟描述問題時表達不清楚造成誤會,不好意思,

希望的效果是若數字開頭不是1才加上G1儲存格內的數字,

以後小弟會儘量將問題再做更具體的描述,請前輩見諒.


小弟擅自將第十二行If Left(T, 1) = "1"改為<>"1"之後,

確實達到期望效果,速度真的比原文我附的檔案快太多了,

而且跟先前程式相比,

前輩所提供的程式碼還加上了刪除重複數字及判別文字有無與數字相連等強大功能,可大幅縮短資料的比對與整理時間,

再次感謝前輩.


其實小弟在第八行之後就已經完全無法理解了,
若方便的話是否冒昧請教前輩,

有關第八行程式碼的部份,
If Not IsNumeric(Right("x" & B, i)) Then v = i - 1: Exit For

這個Right("x" & B, i)的部份,
為何可以使用"x" & B,小弟不太理解這個"x"的用法,
不知是否能夠冒昧麻煩前輩不吝指點迷津,十分感謝.
作者: 准提部林    時間: 2016-10-9 17:14

回復 3# greetingsfromtw


從文字串右方開始取數字, 當遇非數字時, 取得非數字的位置再減一, 即為數字長度,
若該文字串為〔純數字〕或〔空格〕，會發生錯誤，在文字串前強制加一個"x"或任一文字，就可以避免了！
作者: greetingsfromtw    時間: 2016-10-9 23:37

回復 4# 准提部林

真的十分感謝淮提部林前輩的熱心指點.

小弟是否方便再進一步詢問,
關於第11行至第14行,

小弟有試著去網上搜索相關資料,
其中關於冒號的部份,

在論壇上已有前輩做詳細的解說:
http://forum.twbts.com/viewthrea ... ighlight=%B0%7D%A6C

但dictionary object的部份,
小弟不太理解xD(T) > 0這種寫法,
因網路上查到的會需要用item或是items方法.
另第12行,
小弟也不理解何以將 Left(T, 1) = "1"
改為Left(T, 1) <> "1"之後,
就可以將顯示結果對調,因為我並沒有去更動u的值.

其它部份,小弟苦思良久,找尋資料後仍不得其解,


小弟斗膽,

是否能夠冒昧請求前輩略為解釋

第11行至第14行的意義,

還望前輩能夠不吝賜教,十分感謝.
作者: 准提部林    時間: 2016-10-10 10:22

本帖最後由 准提部林 於 2016-10-10 10:24 編輯

回復 5# greetingsfromtw


T = Right(B, v)  >>> v為數字位數, 取出右方字元數
If xD(T) > 0 Then GoTo 101  >>> xD(Key) 可以檢出其Item值, 若是新的Key, 其值為0或"", 否則為舊Key, 略過不計

u = 4 >>> 數字[預設]放在 i 欄, 即陣列第 4 欄
If Left(T, 1) <> "1" Then u = 2: T = [G1] & T >>> 當首字元不為1, 改放于第2欄, 數字前加指定文字

N = N + 1 >>> 取出資料累計數
Brr(N, 1) = Left(B, Len(B) - v) >>> 文字串總長度 - 數字長度 = 文字長度, 由左抓取
Brr(N, u) = T

xD(T) = 1 >>> 新的Key, 一律冠上1為其Item值, 下次就可以做為比對用 (這是字典檔另一用法)
v = 0 >>> 將 v 歸0, 供下一循環重新判斷賦值
作者: greetingsfromtw    時間: 2016-10-10 14:42

回復 6# 准提部林


真的非常感謝准提部林前輩願意花時間一行一行指點小弟這樣不長進的新手,
小弟不勝感激.

能加入這個論壇實在是太好了,一定努力學習.

再次感謝准提部林前輩的無私協助,真的很謝謝您.
作者: Andy2483    時間: 2023-5-11 13:34

回復 2# 准提部林


    謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導

執行前:
[attach]36337[/attach]

執行結果:
[attach]36338[/attach]


Sub Test()
Dim A, B, T$, Brr(1 To 6000, 1 To 4), xD, N&, u, v
'↑宣告變數
[F2:I6000].ClearContents
'↑結果欄儲存格 清除內容
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
For Each A In Range([A2], [A65536].End(xlUp)).Value
'↑設逐項迴圈!令A是A欄裡的儲存格值
For Each B In Split(Replace(A, Chr(10), " "), " ")
'↑設逐項迴圈!令B變數是 A變數被分割成一維陣列的一個陣列值
    For i = 1 To Len(B) + 1
    '↑設順迴圈
        If Not IsNumeric(Right("x" & B, i)) Then v = i - 1: Exit For
        '↑從字串的右往左側找非數字的字元位置i,令v變數是字元位置-1
    Next
    If v = 0 Then GoTo 101
    '↑如果非數字的字元是字串的最後一個字!就跳到101標示位置繼續執行
    T = Right(B, v): If xD(T) > 0 Then GoTo 101
    '↑令T變數是B變數右側的連續數字,
    '↑如果T變數查xD字典得item值 大於0 !
    '就跳到101標示位置繼續執行(濾數字的重複)
    u = 4: If Left(T, 1) = "1" Then u = 2: T = [G1] & T
    '↑令u變數是 4(預設),
    '如果T變數第1個字是1,令u變數是 2,且令T變數前面添加[G1]儲存格值
    N = N + 1: Brr(N, 1) = Left(B, Len(B) - v): Brr(N, u) = T
    '↑令N變數累加 1,令左側文字寫入Brr陣列第1欄,
    '令右側文字依N/u變數寫入Brr陣列
    xD(T) = 1: v = 0
    '↑令以T變數當key,item是1,納入xD字典裡(給後面迴圈濾數字的重複)
101: Next
Next
If N > 0 Then [F2].Resize(N, 4) = Brr
'↑如果有資料!就令Brr陣列值帶入從[F2]開始的精確範圍儲存格
End Sub



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