The attachment has detailed instructions and required results
The attachment has detailed instructions and required results
Last edited by wk9128; 08-17-2020 at 05:41 AM.
Sub test() Dim a, e, i As Long, ii As Long, maxCol As Long With Sheets("sheet2").Cells(1).CurrentRegion.Columns(1) a = .Value ReDim Preserve a(1 To UBound(a, 1), 1 To 100) With CreateObject("Scripting.Dictionary") For i = 2 To UBound(a, 1) For Each e In Split(a(i, 1), ",") If Trim$(e) <> "" Then .Item(Trim$(e)) = Empty Next a(i, 2) = Join(.keys, ",") If UBound(a, 2) < .Count + 1 Then ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 100) For ii = 0 To .Count - 1 a(i, ii + 3) = .keys()(ii) Next If maxCol < .Count + 2 Then maxCol = .Count + 2 .RemoveAll Next End With .Resize(, maxCol) = a End With End Sub
Thank you very much for providing the code, the question is finally answered satisfactorily, you are too good
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks