Изменить формат CSV файла

Question

У меня есть CSV-файл, который находится в следующем формате:

name1 
Date,Type 
11/06/2015 18:13:42,Red 
name2 
Date,Type 
08/06/2015 18:53:38,Blue 
name3 
Date,Type 
10/06/2015 17:13:33,Yellow 
10/06/2015 17:55:11,Green 
name4 
Date,Type 
15/06/2015 11:19:01,Blue 
10/06/2015 13:45:05,Orange 
name5 
Date,Type 
10/06/2015 15:05:14,Purple 

---

Мне нужно изменить формат ниже? Может кто-то рекомендовать способ сделать это ?:

name1,11/06/2015 18:13:42,Red 
name2,08/06/2015 18:53:38,Blue 
name3,10/06/2015 17:13:33,Yellow 
name3,10/06/2015 17:55:11,Green 
name4,15/06/2015 11:19:01,Blue 
name4,10/06/2015 13:45:05,Orange 
name5,10/06/2015 15:05:14,Purple 

Примечание некоторые имена имеют более чем на 1 запись.

Заранее благодарен!

Answer 1

Эта процедура использует сценарий .Dictionary. Вам нужно будет войти в Инструменты VBE ► Ссылки и добавить в свой проект Microsoft Scripting Runtime, прежде чем сможете его использовать.

Если вы можете открыть CSV в качестве активной книги, тогда эта короткая процедура должна реорганизовать ваши данные.

Sub collate_CSV() 
    Dim rw As Long, lr As Long, v As Long 
    Dim dRECs As New Scripting.Dictionary 
    Dim vKEY As Variant, vITM As Variant, vVALs As Variant 

    dRECs.CompareMode = TextCompare 
    ReDim vVALs(1 To 1) 

    With Sheet1 '<-CSVs almost always have their single worksheet codename as Sheet1 
     lr = .Cells(Rows.Count, 1).End(xlUp).Row 
     For rw = lr To 2 Step -1 
      Select Case LCase(.Cells(rw, 1).Value2) 
       Case vbNullString 
        'do nothing 
       Case "date,type" 
        ReDim Preserve vVALs(1 To UBound(vVALs) - 1) 
        dRECs.Add Key:=.Cells(rw - 1, 1).Value2, Item:=Join(vVALs, ChrW(8203)) 
        ReDim vVALs(1 To 1) 
        .Cells(rw - 1, 1).Resize(Rows.Count - rw + 1, 1).EntireRow.Delete 
       Case Else 
        vVALs(UBound(vVALs)) = .Cells(rw, 1).Value2 
        ReDim Preserve vVALs(1 To UBound(vVALs) + 1) 
      End Select 

     Next rw 

     For Each vKEY In dRECs 
      vITM = Split(dRECs.Item(vKEY), ChrW(8203)) 
      For v = LBound(vITM) To UBound(vITM) 
       .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = _ 
        vKEY & Chr(44) & vITM(v) 
      Next v 
     Next vKEY 

     .Rows(1).EntireRow.Delete 

    End With 

End Sub 

Ваши результаты должны быть похожи на следующее:

Результаты перепутаны от оригинала. Это фактор перехода от нижней части данных к вершине, удаление потраченных записей по мере продвижения работы.