- 帖子
- 406
- 主題
- 8
- 精華
- 0
- 積分
- 453
- 點名
- 0
- 作業系統
- WINDOWS 7
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2015-2-7
- 最後登錄
- 2021-7-31
|
本帖最後由 n7822123 於 2018-8-31 23:51 編輯
回復 7# n7822123
總算看懂你要的了,看看這個是否符合你的需求
假設第一欄是標題,第二欄是內容,
第三欄放不重複的標題,第4欄往後放同樣標題的內容(內容用欄做分格)
應該是這樣吧!?
全程序修改如下!
sample_001-0831.rar (289.56 KB)
- Sub test()
- Dim dic As Object, data, i%, AA$
- Dim bb() As String
- Set dic = CreateObject("scripting.dictionary")
- data = Range(Cells(1, 1), Cells(1, 2).End(4))
- For i = 1 To UBound(data)
- AA = data(i, 1)
- If Not dic.exists(AA) Then
- dic(AA) = data(i, 2)
- Else
- If InStr(dic(AA), data(i, 2)) = 0 Then
- dic(AA) = dic(AA) & "," & data(i, 2)
- End If
- End If
- Next
- Cells(1, 3).Resize(dic.Count, 1) = Application.Transpose(dic.keys)
- For i = 1 To dic.Count
- AA = data(i, 1)
- bb = Split(dic(AA), ",")
- Cells(i, 4).Resize(1, UBound(bb) + 1) = bb
- Next i
- Set dic = Nothing
- End Sub
複製代碼 |
|