帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2016-10-8 21:14 | 只看該作者

大筆資料換行處理與數字文字分隔問題

各位前輩好,

小弟目前遇到一個問題,

附上檔案連結:
點擊下載

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

文字放在F欄,

數字的部份,

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

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

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

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

但有以下缺點:

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

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

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

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

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

十分感謝.

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

2^#

發表於 2016-10-9 11:46 | 只看該作者

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")
For Each A In Range([A2], [A65536].End(xlUp)).Value
For Each B In Split(Replace(A, Chr(10), " "), " ")
For i = 1 To Len(B) + 1
If Not IsNumeric(Right("x" & B, i)) Then v = i - 1: Exit For
Next
If v = 0 Then GoTo 101
T = Right(B, v): If xD(T) > 0 Then GoTo 101
u = 4: If Left(T, 1) = "1" Then u = 2: T = [G1] & T
N = N + 1: Brr(N, 1) = Left(B, Len(B) - v): Brr(N, u) = T
xD(T) = 1: v = 0
101: Next
Next
If N > 0 Then [F2].Resize(N, 4) = Brr
End Sub

複製代碼

Xl0000047.rar (14.61 KB)

TOP

greetingsfromtw

中學生 Rank: 2

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

3^#

發表於 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"的用法,
不知是否能夠冒昧麻煩前輩不吝指點迷津,十分感謝.

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

4^#

發表於 2016-10-9 17:14 | 只看該作者

回復 3# greetingsfromtw

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

TOP

greetingsfromtw

中學生 Rank: 2

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

5^#

發表於 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行的意義,

還望前輩能夠不吝賜教,十分感謝.

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

6^#

發表於 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, 供下一循環重新判斷賦值

TOP

greetingsfromtw

中學生 Rank: 2

帖子: 45
主題: 10
精華: 0
積分: 59
點名: 0
作業系統: Win7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2014-2-6
最後登錄: 2019-6-22

論壇贊助勳章

7^#

發表於 2016-10-10 14:42 | 只看該作者

回復 6# 准提部林

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

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

再次感謝准提部林前輩的無私協助,真的很謝謝您.

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

8^#

發表於 2023-5-11 13:34 | 只看該作者

回復 2# 准提部林

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

執行前:

執行結果:

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP