各位前輩好,
小弟最近在練習時遇到一個問題,
附上檔案以供前輩參考:
 20161115_(字典物件)單格多行儲存格分隔為多行單格儲存格問題.zip (9.86 KB)
將問題以文字簡述如下:
假設有兩直欄資料,
A欄為一般文字,B欄的每個儲存格均有多筆資料,每筆資料有換行,
示意如下:
B欄
111
222
333
以上三筆數字均在同一個儲存格中.
希望可以將B欄的每筆資料分隔至單一儲存格,貼至F欄,
並將A欄的資料依據B欄的資料去貼上,
承上例,
假設上例之B欄對應之A欄儲存格為"AAA",
則期望結果如下:
A欄 B欄
AAA 111
AAA 222
AAA 333
小弟冒昧借用論壇前輩以及網上其他朋友的程式碼進行修改,
修改之程式碼如下:- Sub test()
- '此為參考論壇前輩及網上其他朋友所提供之程式碼進行修改,
- '非我原創
- '論壇網址;http://forum.twbts.com/thread-18600-1-1.html
- Dim Arr, Brr(1 To 65536, 1 To 1), myD, C, UC
- '關閉螢幕更新
- Application.ScreenUpdating = False
- Set myD = CreateObject("scripting.dictionary")
- Arr = Range("a2:c" & Cells(Rows.Count, "a").End(3).Row).Value
- '清除結果欄的資料
- Range("e2", Cells(Rows.Count, "f")).ClearContents
- For Each A In Range("b2:b" & Cells(Rows.Count, "b").End(3).Row).Value
- For Each B In Split(A, Chr(10))
-
- '將B欄多行儲存格內的值分割並代入陣列,
- '使用字典物件將重複值刪除
- If myD(B) = 1 Then GoTo 101
- N = N + 1
- Brr(N, 1) = B
- myD(B) = 1
- 101: Next B
- Next A
- [f2].Resize(N, 1) = Brr
- '"---"虛線範圍內的程式碼在B欄多行儲存格有重複資料或空行時會出現問題
- '-------------------------------------------------------
- '計算B欄多行儲存格內的值的總數量並顯示於C欄
- For i = 1 To UBound(Arr)
- C = Split(Arr(i, 2), Chr(10))
- UC = UBound(C) + 1
- Arr(i, 3) = UC
- Next i
- [a2].Resize(UBound(Arr), 3) = Arr
- '將A欄的資料依C欄的次數貼至E欄
- For j = 2 To UBound(Arr) + 1
- Cells(j, 1).Copy _
- Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Resize(Cells(j, 3), 1)
- Next j
- '-------------------------------------------------------
- 'C欄的數字使用者用不到,故在最後清除C欄
- Columns(3).ClearContents
- '開啟螢幕更新
- Application.ScreenUpdating = True
- End Sub
問題情形煩請參考附檔所示.
小弟苦思許久,還是無法解決,斗膽上來求助,
還望前輩不吝指點迷津,十分感謝 |
發表於 2016-11-15 21:42
| 
