MS Excel 03 - Suppression de lignes contenant des identifiants de chaîne dans la colonne A, concaténant d'autres valeurs

Question

Ce document XML est fourni en tant que flux de données (je ne peux pas modifier directement la source du flux de données) et je l'importe en Excel avec l'importation xml. il n'y a pas de schéma qui vient avec ce xml donc j'obtiens une table qui finit par avoir tout un tas de doublons pour un identifiant, à cause des valeurs uniques réparties dans la feuille de calcul.

XML in XLS 

Col1(IDnum) Col2(name) Col3(Type) Col4(Category) Col(etc) 
================================================================= 
0011   Item   01       6B 
0011   Item      xxj9   7B 
0011   Item      xxj9 
0011   Item   02 
0011   Item   01   xxj9   6B 
0012   etc 

J'ai besoin de supprimer toutes les lignes où la chaîne COLUMNA/numéro correspond en concaténer toutes les valeurs possibles de Col3, Col4 & Col5 ensemble il ressemble à ce

Col1(IDnum) Col2(name) Col3(Type) Col4(Category) Col(etc) 
================================================================= 
0011   Item   01, 02   xxj9   6B, 7B 

quelle méthode de Visual Basic me permettrait pour y parvenir?

grâce

Answer 1

Peut-être:

Dim cn As Object 
Dim rs As Object 
Dim strFile As String 
Dim strCon As String 
Dim strSQL As String 
Dim s As String 
Dim i As Integer, j As Integer 

''This is not the best way to refer to the workbook 
''you want, but it is very conveient for notes 
''It is probably best to use the name of the workbook. 

strFile = ActiveWorkbook.FullName 

''Note that if HDR=No, F1,F2 etc are used for column names, 
''if HDR=Yes, the names in the first row of the range 
''can be used. 
''This is the Jet 4 connection string, you can get more 
''here : http://www.connectionstrings.com/excel 

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ 
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" 

''Late binding, so no reference is needed 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 


cn.Open strCon 

''Name and Type are reserved words: 
''http://office.microsoft.com/en-us/access/hp010322491033.aspx, 
''so square brackets are required. Brackets would also be 
''needed if the column name had a space in it. 
''Name is just about the worst thing to call something that will 
''be used with VBA or SQL :) 

''This selects the fields (columns) by name and groups on all 
''fields. If some fields (columns) contain unimportant data or 
''data that does not need to be concatenated, you can use, say 
''First ... SELECT IDNum First(Category) 
''You can also simply ORDER BY IdNum, rather than GROUP BY 
''it may be a little slower. 

strSQL = "SELECT IDNum, [Name], [Type], Category, Etc " _ 
     & "FROM [Sheet1$] " _ 
     & "WHERE IDNum Is Not Null " _ 
     & "GROUP BY IDNum, [Name], [Type], Category, Etc" 

''It is best to use column names, but at a pinch and for a 
''once-off you coukd use: 

''strSQL = "SELECT * " _ 
''  & "FROM [Sheet1$] " _ 
''  & "WHERE IDNum Is Not Null " _ 
''  & "ORDER BY IDNum" 

''Open the recordset for more processing 
''Cursor Type: 3, adOpenStatic 
''Lock Type: 3, adLockOptimistic 
''Not everything can be done with every cirsor type and 
''lock type. See http://www.w3schools.com/ado/met_rs_open.asp 

rs.Open strSQL, cn, 3, 3 


''Pick a suitable empty worksheet for the results 

With Worksheets("Sheet2") 

    ''Fill headers into the first row of the worksheet 

    For i = 0 To rs.Fields.Count - 1 
     .Cells(1, i + 1) = rs.Fields(i).Name 
Next 

    ''Counter for Fields/Columns in Recordset and worksheet 
    ''Row one is used with tiles, so ... 
    i = 1 

    ''Working with the recordset ... 

    Do While Not rs.EOF 

     ''While there are records ... 
     If rs.EOF Then Exit Do 

     ''Store the IDNum to a string (if it is a long, 
     ''change the type) ... 

     s = rs!IDNum 

     ''(Counter) 
     i = i + 1 

     ''(First cell in sheet) 
     .Cells(i, 1) = rs!IDNum 

     ''Working with the saved IDNum string ... 
     Do While s = rs!IDNum 

      ''And the fields (columns) in the Recorset ... 
      ''(-1 because we already have IDNum, which is zero) 

      For j = 1 To rs.Fields.Count - 1 

       ''If the cell (row=i, column=j) that contains Recordset field (column) 
       ''Does not already have this data (Instr) and the value in the recordset 
       ''is not Null, ZLS, Space filled then ... 

       If InStr(.Cells(i, j + 1), rs(j)) = 0 _ 
        And Trim(rs(j) & vbNullString) <> vbNullString Then 

        ''If the cell already has a value ... 
        If Not IsEmpty(.Cells(i, j + 1)) Then 
         ''add a comma delimiter 
         .Cells(i, j + 1) = .Cells(i, j + 1) & ", " 
        End If 

        ''Add the value from the recordset to the cell (concatenate). 
        .Cells(i, j + 1) = .Cells(i, j + 1) & rs(j) 
       End If 
      Next 

     ''Keep going for this IDNum 
     rs.MoveNext 

     ''But stop if at the end of the recordset. 
     If rs.EOF Then Exit Do 
    Loop 
    ''Keep going for this recordset 
Loop 

''Finished with the sheet 
End With 

''Tidy up 
rs.Close 
Set rs = Nothing 
cn.Close 
Set cn = Nothing