Discussion :

[rayba89]

Bonjour,

Je pars d'un fichier excel avec plusieurs identifiants (prenon par exemple)
pour chaque identifiant j'ai plusieurs attributs.
Trois de ces attributs contiennent des termes delimités par des ";"
Mon besoin est de créer une ligne pour chaque terme dans ces attributs et effacer touts les autres termes dans les 3 attributs en question.
en pj un exemple qui montre le resultat attendu.

j'ai developpé un premier code (qui n'est pas complet mais j'aimerais voir ce que ca donne) mais ca ne marche pas!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
 
Private Sub CommandButton1_Click()
Dim monDict
Dim SP_A$()
Dim SP_B$()
Dim SP_C$()
Set monDict = CreateObject("Scripting.dictionary")
Dim nbre As Variant
Dim aux
Dim i
 
With ThisWorkbook.Worksheets(1)
For Each nbre In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp))
If Not monDict.Exists(CStr(nbre.Value)) Then
    monDict.Add CStr(nbre.Value), CStr(nbre.Row)
End If
Next nbre
End With
 
 
Dim cle
 
For Each cle In monDict.Keys
aux = monDict.Item(cle)
SP_A = Split(Cells(aux, 5), ";")
SP_B = Split(Cells(aux, 6), ";")
SP_C = Split(Cells(aux, 7), ";")
For i = 0 To UBound(SP_A)
Cells(aux, 1).Select
ActiveCell.Offset(1).EntireRow.Insert
Cells(aux, 1).Select
ActiveCell.EntireRow.Copy Cells(aux + 1, 1)
Cells(aux+i , 6).Select
Selection.ClearContents
Cells(aux+i , 7).Select
Selection.ClearContents
Next i
Next cle
End Sub

ca m'envoie le message d'erreur suivant :

erreur d'exécution '1004'
erreur definie par l'application ou par l'objet

Ca se produit à la ligne de code suivante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each nbre In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp))

Je voulais reproduire le meme code pour "SP_B" et "SP_C" mais je la je bloque au tout debut.

Je pensais faire aussi l'algo suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
UBound_tot = UBound(SP_A) + UBound(SP_C) + UBound(SP_C)
for i=0 to UBound_tot
'insert new row
'if i<UBound(SP_A)  donc cell(aux,6) <- SP_A(i)
'if UBound(SP_A) < i < UBound(SP_A) + UBound(SP_B) 
'donc cell(aux,7) <- SP_B(i)
'if UBound(SP_A) + UBound(SP_B) < i < UBound_tot
'donc cell(aux,8) <- SP_C(i)

quelqu'un aura une meilleure idée?
en pj la macro (feuille 2)

Merci d'avance pour votre aide