標題:
求助~拆解Cell欄位
[打印本頁]
作者:
tommy.lin
時間:
2014-5-6 18:06
標題:
求助~拆解Cell欄位
[attach]18223[/attach]
各位高手~小弟有個檔案ID 部分內容有多個ID(個數不一)分隔符號分別為; 以及/
不知是否有辦法可以透過程式將表單ID 轉換成單一行
感謝高手相助~
作者:
Kubi
時間:
2014-5-7 08:44
回復
1#
tommy.lin
試看看。
檔案下載：http://ge.tt/2cokpIg1/v/0?c
作者:
tommy.lin
時間:
2014-5-7 09:32
好像需要申請帳號才可以下載是?
作者:
Kubi
時間:
2014-5-7 09:39
回復
3#
tommy.lin
拆解來源為A、B欄，
拆解後寫入C、D欄。
Option Base 1
Sub test()
Dim arr1, arr2
Dim brr()
er = [A65536].End(3).Row
arr1 = Range("A2:B" & er)
ActiveSheet.Columns(2).Replace "/", ";"
arr2 = Range("A2:B" & er)
For i = 1 To UBound(arr2)
For j = 0 To UBound(Split(arr2(i, 2), ";"))
n = n + 1
ReDim Preserve brr(2, n)
If j = 0 Then brr(1, n) = arr2(i, 1)
brr(2, n) = Split(arr2(i, 2), ";")(j)
Next j
Next i
[C2:D65536].ClearContents
[C2].Resize(UBound(brr, 2), 2) = Application.Transpose(brr)
Range("A2:B" & er) = arr1
arr1 = ""
arr2 = ""
Erase brr
End Sub
作者:
tommy.lin
時間:
2014-5-7 11:50
可以了~~ 感謝喔~~
怎麼樣練習可以變這麼強?
還是有地方可以上課?
作者:
tommy.lin
時間:
2014-5-7 13:33
Hi Kubi:
又如果我的資料拆解來源是A & D 欄位我要如何修改VB 變成我想要的?
Regards
Tommy
作者:
Kubi
時間:
2014-5-7 14:15
回復
6#
tommy.lin
資料拆解來源是A & D 欄....
可否請版大附上如#1的圖形，以方便了解所需。
作者:
tommy.lin
時間:
2014-5-7 15:31
[attach]18231[/attach]
Hi Kubi:
不好意思~初學者問題太多@@"希望沒造成你困擾
Regards
Tommy
作者:
Kubi
時間:
2014-5-7 19:37
回復
8#
tommy.lin
檔案下載：http://ge.tt/5PcoXKg1/v/0?c
拆解來源為A∼D欄，
拆解後寫入E∼I欄。
Option Base 1
Sub test1()
Dim arr1, arr2
Dim brr()
er = [A65536].End(3).Row
arr1 = Range("A2:D" & er)
ActiveSheet.Columns(4).Replace "/", ";"
arr2 = Range("A2:D" & er)
For i = 1 To UBound(arr2)
For j = 0 To UBound(Split(arr2(i, 4), ";"))
n = n + 1
ReDim Preserve brr(5, n)
If j = 0 Then
brr(1, n) = arr2(i, 1)
brr(2, n) = arr2(i, 2)
brr(3, n) = arr2(i, 3)
brr(4, n) = arr2(i, 1)
End If
brr(5, n) = Split(arr2(i, 4), ";")(j)
Next j
Next i
[E2:I65536].ClearContents
[E2].Resize(UBound(brr, 2), 5) = Application.Transpose(brr)
Range("A2:D" & er) = arr1
arr1 = ""
arr2 = ""
Erase brr
End Sub
作者:
tommy.lin
時間:
2014-5-8 09:21
Hi Kubi:
測試可以使用
感謝你的幫忙..
有空假日可以個別教學?@@"
Regards
作者:
tommy.lin
時間:
2014-5-8 14:55
[attach]18238[/attach]Hi Kubi:
又產生一個問題了@@" TOPIC ID 分開之後ID 欄位產生多個空白cell 空白的cell 需要跟上面的ID 補齊
單純手動我可以很快完成但是如何變成VBA ?
Regards
Tommy
作者:
Kubi
時間:
2014-5-8 20:00
回復
11#
tommy.lin
那就將
brr(4, n) = arr2(i, 1)
移到判斷式之外。
擷取修改部份：
If j = 0 Then
brr(1, n) = arr2(i, 1)
brr(2, n) = arr2(i, 2)
brr(3, n) = arr2(i, 3)
brr(4, n) = arr2(i, 1)
End If
brr(5, n) = Split(arr2(i, 4), ";")(j)
改成如下：
If j = 0 Then
brr(1, n) = arr2(i, 1)
brr(2, n) = arr2(i, 2)
brr(3, n) = arr2(i, 3)
End If
brr(4, n) = arr2(i, 1)
brr(5, n) = Split(arr2(i, 4), ";")(j)
作者:
jiwen818
時間:
2014-5-10 23:06
其實重點是ActiveSheet.Columns(4).Replace "/", ";"這欄
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
有空假日可以個別教學?@@"