返回列表 上一主題 發帖

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

  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
複製代碼
Xl0000047.rar (14.61 KB)

TOP

回復 3# greetingsfromtw


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

TOP

本帖最後由 准提部林 於 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

        靜思自在 : 有願放在心裡,沒有身體力行,正如耕田不播種,皆是空過因緣。
返回列表 上一主題