Dé-combinaison de ligne avec clé primaire
Bonjour à tous ,
Je me permet de poster dans ce forum car j'ai besoin d'aide et voici mon problème :
Afin de bien comprendre mon soucis je vais expliquer quel type de donnée je travail avec, ce que j'en ai fait et ce que je voudrais faire et dont la solution est difficile à trouver.
Je travail avec des fichiers de facture que j'importe depuis un logiciel de facturation vers un autre logiciel. Le premier logiciel de facturation me sort des fichiers excel que je transforme en fichier csv afin de les intégrer dans le nouveau logiciel.
Il y avait dans le premier fichier excel plusieurs facture avec le même ID alors je les ai combinés afin qu'il n'y ai qu'une ID avec les articles sur la même ligne séparer par des back slash. L'ID facture étant la clé primaire j'ai pu introduire le csv dans le nouveau logiciel. J'ai traité et arrangé ces factures dans le nouveau logiciel puis les ai exporté en csv.
VOICI MA QUESTION :
Je voudrais faire l'opération inverse c'est à dire remettre tout les articles sur des lignes avec l'ID identique. J'ai joint un fichier exemple afin que vous ayez une idée du type de fichier.
Exemple : ID1 art1\art2\art3 prix1\prix2\prix3
Qui donnera :
ID1 art1 prix1
ID1 art2 prix2
ID1 art3 prix3
Voilà j'ai essayé d'être le plus explicite possible.
Merci d'avance pour vos réponses !
PS : J'ai tenté avec Kutools c'est bien pour diviser mais diviser selon une clé primaire je n'ai pas trouvé.
Bonjour,
Tu peux le faire avec l'assistant de conversion (Menu Données / Convertir) et tu indiques en séparateur "Autre" \
Je ne sais pas si c'est exactement ce que tu veux.
*EDIT*
Après relecture de ta demande, ça ne doit pas correspondre exactement à ce que tu cherches, désolé.
Bonjour Paulox,
Merci quand même d'avoir tenter mais effectivement ça ne correspond pas vraiment à ce que je voudrais faire.
Cordialement
Bonjour,
Pas sûr d'avoir bien compris mais pour voir le résultat, ajouter une feuille nommée "Feuil2" :
Sub Test()
Dim Plage As Range
Dim Cel As Range
Dim T_Article
Dim T_Prix
Dim I As Integer
Dim J As Integer
With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp)): End With
For Each Cel In Plage
T_Prix = Split(Cel.Offset(, 1).Value, "\")
T_Article = Split(Cel.Offset(, 2).Value, "\")
For J = 0 To UBound(T_Prix)
I = I + 1: Worksheets("Feuil2").Cells(I, 1).Value = Cel.Value & " " & T_Prix(J) & " " & T_Article(J)
Next J
Next Cel
End Sub
Bonjour These,
Premièrement merci pour cette réponse l'idée est la. Je suis novice en VBA j'ai pu voir ce que cela donne et je vais tenté de modifier un peu votre code pour que cela donne exactement ce que je voudrais. Je vous tiens au courant !
Merci pour cette piste.
Cordialement
Dans ce cas, avec les commentaires :
Sub Test()
Dim Plage As Range
Dim Cel As Range
Dim T_Article
Dim T_Prix
Dim I As Integer
Dim J As Integer
'défini la plage en colonne D de la feuille "Feuil1" à partir de A1
With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp)): End With
'boucle sur les cellules de la plage...
For Each Cel In Plage
'splite dans les tableaux qui sont de dimensions identiques
T_Prix = Split(Cel.Offset(, 1).Value, "\")
T_Article = Split(Cel.Offset(, 2).Value, "\")
'boucle sur les tableaux et concatène l'ID qui est en cellule D, le prix et l'article qui eux sont dans les tableaux
For J = 0 To UBound(T_Prix)
I = I + 1: Worksheets("Feuil2").Cells(I, 1).Value = Cel.Value & " " & T_Prix(J) & " " & T_Article(J)
Next J
Next Cel
End Sub
Merci pour les commentaires en plus ! J'ai fais quelques test depuis tout à l'heure sans grand succès. Je suis malheureusement pressé par le temps
J'ai fais un exemple en excel que j'ai mis en pièce jointe. Je dois faire le même type de démarche pour quelques milliers de facture. La piste est très bonne mais mes connaissances en VBA pour l'instant ne me permette pas de résoudre cela avant le temps qui est imposé.
Pouvez-vous me montrer comment le faire ?
Cordialement
Nouveau code à tester !
Les valeurs commencent à la ligne 3 (comme dans ton dernier fichier) et il faut qu'une feuille nommée "Feuil2" existe dans le classeur :
Sub Test()
Dim Plage As Range
Dim Lig As Range
Dim Cel As Range
Dim T
Dim I As Integer
Dim J As Integer
Dim L As Integer
'défini la plage sur toute la feuille à partir de A3
Set Plage = DefPlage(Worksheets("Feuil1"), 3)
'initialise la variable
I = 1
'résultat en feuille "Feuil2" <-- adapter le nom de la feuille !
With Worksheets("Feuil2")
'parcours les lignes de la plage afin de pouvoir afin de pouvoir, à chaque changement, incrémenter la variable I (voir astérisque *)
For Each Lig In Plage.Rows
'parcours les cellules de la ligne en cours
For Each Cel In Lig.Cells
'si elle est inférieure à 5...
Select Case Cel.Column
'tire vers le bas après avoir récupérer le nombre de lignes nécessaires
Case Is < 5
L = UBound(Split(Plage(Cel.Row - 2, 5).Value, "\"))
.Cells(I, Cel.Column).Value = Cel.Value
.Cells(I, Cel.Column).AutoFill Range(.Cells(I, Cel.Column), .Cells(I + L, Cel.Column))
'si supérieure, splite dans un tableau les valeurs et les réparti sur les lignes en supprimant les "
Case Else
T = Split(Plage(Cel.Row - 2, Cel.Column).Value, "\")
For J = 0 To UBound(T)
.Cells(J + I, Cel.Column).Value = Replace(T(J), """", "")
Next J
End Select
Next Cel
I = I + UBound(T) + 1 '*
Next Lig
End With
End Sub
Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range
On Error GoTo Fin
With Fe
Set DefPlage = .Range(.Cells(L, C), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
Exit Function
Fin:
Set DefPlage = Nothing
End Function
Bonjour,
Merci bcp pour cette solution ! De mon coté j'ai aussi trouvé une solution que je met ici au cas ou quelqu'un en a besoin :
Sub report()
Application.ScreenUpdating = False
Sheets("Facture_01.10.2019").Rows(1).Copy Destination:=Sheets("Feuil3").Range("A1")
ligne = 2
For n = 2 To Sheets("Facture_01.10.2019").Range("A" & Rows.Count).End(xlUp).Row
x = Split(Sheets("Facture_01.10.2019").Range("E" & n), "\")
If UBound(x) = 0 Then
For m = 1 To 13
Sheets("Feuil3").Cells(ligne, m) = Replace(Sheets("Facture_01.10.2019").Cells(n, m), """", "")
Next
ligne = ligne + 1
Else
For p = LBound(x) To UBound(x)
For m = 1 To 13
If InStr(Sheets("Facture_01.10.2019").Cells(n, m), "\") <> 0 Then
On Error Resume Next
Sheets("Feuil3").Cells(ligne, m) = Replace(Split(Sheets("Facture_01.10.2019").Cells(n, m), "\")(p), """", "")
On Error GoTo 0
Else
Sheets("Feuil3").Cells(ligne, m) = Replace(Sheets("Facture_01.10.2019").Cells(n, m), """", "")
End If
Next
ligne = ligne + 1
Next
End If
Next
Application.ScreenUpdating = True
Sheets("Feuil3").Select
End Sub
Il suffit après de changer le nom des feuillles.
Je procède mtn à la cloture du sujet
Merci bcp
Cordialement