jointure de lignes

[eliseH]

Bonjour,

Cela fait maintenant une journée que j'essaye par l'intermédaire des tutoriaux et des forums de résoudre un problème mais je sèche:
J'essaye de réaliser une fusion de ligne quand le champs de le colonne C est égal au champ de la ligne suivante de la colonne B

Je m'explique:
Je dispose d'un fichier excel avec comme champs et comme données:

Numero autoroute ; point kilomètrique début ; point kilomètrique fin
A8 ; 100 ; 200
A8 ; 200 ; 300
A8 ; 300; 400
A8 ; 500 ; 600

Je souhaiterai fusionner les lignes ou le point kilométrique fin est égale au point kilométrique début de la ligne suivante afin d'otenir cela:

Numero autoroute ; Point kilomètrique début : point kilomètrique fin
A8 ; 100 ; 400
A8 ; 500 ; 600

Je pense qu'il faut partir sur une macro (car je vais devoir réaliser cette opération sur plusieurs fichiers Excel).

Je connais un peu VBA mais je ne l'ai jamais appliqué à Excel est j'ai bcp de mal à comprendre les fonction range et cells (d'ailleurs si vous pouviez expliquez votre cheminement pour m'aider à comprendre, ce serait vraiment gentil)

Je vous remercie

 

[pierrejean]

Re : jointure de lignes

bonjour eliseH

vois si cela te convient

 

[ROGER2327]

Re : jointure de lignes

Bonjour eliseH, bonjour pierrejean

Une proposition à essayer dans le classeur joint. Si cela va dans le bon sens, il sera temps de commenter le code...​

ROGER2327

 

[ROGER2327]

Re : jointure de lignes

Suite...

Le code donné dans l'envoi précédent peut être remplacé par celui-ci :

[COLOR="DarkSlateGray"]Option Explicit

Sub regroupe()
Dim i As Long, tf As Boolean
Dim oDat(), dDat()
   With Sheets("Feuil1").[A1].CurrentRegion
      On Error GoTo pas_de_données
      oDat = .Resize(.Rows.Count - 1, 3).Offset(1, 0).Value [COLOR="SeaGreen"]'_______________________________A[/COLOR]
      On Error GoTo 0
   End With
   ReDim dDat(1 To 3, 1 To 1)
   dDat(1, 1) = oDat(1, 1)
   dDat(2, 1) = oDat(1, 2)
   For i = 2 To UBound(oDat, 1)
      If oDat(i - 1, 1) <> oDat(i, 1) Or oDat(i - 1, 3) <> oDat(i, 2) Then
         dDat(3, UBound(dDat, 2)) = oDat(i - 1, 3)
         ReDim Preserve dDat(1 To 3, 1 To 1 + UBound(dDat, 2))
         dDat(1, UBound(dDat, 2)) = oDat(i, 1)
         dDat(2, UBound(dDat, 2)) = oDat(i, 2)
      End If
   Next i
   dDat(3, UBound(dDat, 2)) = oDat(i - 1, 3)
   With Sheets("Feuil2")
      If IsEmpty(.[A2].Value) Then
         Sheets("Feuil1").[A1:C1].Copy Destination:=.[A1:C1]
         .[A2].Resize(UBound(dDat, 2), UBound(dDat, 1)).Value = Application.Transpose(dDat)
      Else
         With .[A1].End(xlDown)
            On Error Resume Next
            tf = .Value = dDat(1, 1) And .Offset(0, 2).Value = dDat(2, 1)
            On Error GoTo 0
            If tf Then
               dDat(2, 1) = .Offset(0, 1)
               .Resize(UBound(dDat, 2), UBound(dDat, 1)).Value = Application.Transpose(dDat)
            Else
               .Offset(1, 0).Resize(UBound(dDat, 2), UBound(dDat, 1)).Value = Application.Transpose(dDat)
            End If
         End With
      End If
   End With
Exit Sub
[COLOR="SeaGreen"]'
'###  Gestion des erreurs  ###
'[/COLOR]
pas_de_données:
[COLOR="SeaGreen"]'survient si il n'y a pas de données à traiter. (A)[/COLOR]
   ReDim oDat(1 To 1, 1 To 3)
   Resume Next
End Sub[/COLOR]

Ce code est fondamentalement semblable au précédent. Les modifications apportées concernent la gestion des erreurs pouvant survenir en cas d'application du code à une plage de données vide ou à une plage de données ne comportant qu'une seule ligne.​

ROGER2327

 

[eliseH]

Re : jointure de lignes

Merci beaucoup pour vos réponses, vos deux propositions fonctionnent parfaitement!
J'ai réussi à comprendre la macro de PierreJean sans problème mais pour celle de Roger2327, je sèche sur certains points. Serait il possible de m'expliquer votre raisonnement?

 

[ROGER2327]

Re : jointure de lignes

Re...

Je joins les commentaires de la procédure. Ce type de document est assez long à rédiger : je vous serai reconnaissant de me faire part de vos remarques, de me signaler les points obscurs ou superflus. Cela me permettra d'améliorer la qualité des réponses que j'essaie d'apporter. Merci d'avance.​

ROGER2327

 

[eliseH]

Re : jointure de lignes

Merci beaucoup. Je n'aurai pas le temps de regarder cette aprés midi mais je me penche dessus ce soir.