Aux férus de VBA

Bonjour,

je joint un tableau détaillant des factures dont le nombre peut fluctuer et je voudrais automatiser la colonne M ("commentaire").

Je voudrais qu'au clic de la macro les commentaires se génèrent automatiquement.

Le problème c'est que ces commentaires doivent se regrouper dans une seule cellule par facture alors qu'une facture comporte plusieurs lignes (voir le tableau pour mieux comprendre) qui correspondent à des prestations.

Ces commentaires sont en fonction de la colonne G et H ("Début et fin de période") et de la colonne L ("chantier")

Par exemple sur ma facture 2 j'ai un début de période le 05/10/2016 (colonne G) et une fin (colonne H) le 08/10/2016 et mon chantier (colonne L) du 06/10/2016 au 07/10/2016

Mon commentaire (colonne M) doit être : "période du 05/10/2016 au 08/10/2016 et chantier du 06/10/2016 au 07/10/2016"

Mais la ou ça se corse énormément pour moi c'est qu'il peut y avoir plusieurs période différentes dans une même facture.

Et là je coince...

Actuellement je le fais manuellement et j'ai un fichier avec plus de 1000 factures...

si quelqu'un a une piste , en créant des colonnes en concaténant... etc je suis preneur

J'espère que quelqu'un pourra m'apporter son aide.

Par avance merci

Bonne soirée

Eno

Bonjour,

solution via une macro

Sub aargh()
    With Sheets("feuil1") ' feuille
        dl = .Cells(Rows.Count, 2).End(xlUp).Row + 1 'dernière ligne à triater
        ref = "" ' date de reference
        Facture = "" 'facture de reference
        For i = 2 To dl 'on parcourt les lignes
            If .Cells(i, "G") & .Cells(i, "H") <> ref Then 'changement de date de début et de fin
                If ref <> "" Then 'si facture existe
                    .Cells(k, "M") = "période du " & .Cells(pl, "G") & " au " & .Cells(i - 1, "H") & " et chantier du " & .Cells(pl, "L") & IIf(.Cells(pl, "L") <> .Cells(i - 1, "L"), " au " & .Cells(i - 1, "L"), "")
                    k = k + 1 'ligne pour commentaire suivant
                End If
                pl = i 'première ligne chantier
                ref = .Cells(i, "G") & .Cells(i, "H") 'date de références
                If Facture <> .Cells(i, 1) And .Cells(i, 1) <> "" Then 'nouvelle facture ?
                    k = i 'ligne pour commentaire suivant
                    Facture = .Cells(i, 1) 'facture de référence
                End If
            End If
        Next i
    End With
End Sub

Bonjour h2so4.

Bonjour Eno83.

Une méthode différente :

Option Explicit
Dim arrFacture()
Dim ligne&, ligneFact&
Dim finChantier As Date

Sub commentaireFactures()
Dim numFac&
Dim debRef As Date, finRef As Date, debChantier As Date

'Enregistrement du tableau dans un virtuel.
arrFacture = Sheets("Feuil1").[a1].CurrentRegion.Value

'Boucle des lignes par facture.
For ligne = LBound(arrFacture) + 1 To UBound(arrFacture)
    numFac = arrFacture(ligne, 1)
    If ligne = 2 Then
        ligneFact = ligne
        Else
        If numFac <> 0 Then ligneFact = ligne
    End If
    debRef = arrFacture(ligne, 7)
    finRef = arrFacture(ligne, 8)
    debChantier = arrFacture(ligne, 12)
        Call recursiviteFacture(debRef, finRef, debChantier, ligne)
Next ligne
End Sub

Sub recursiviteFacture(debRef As Date, finRef As Date, debChantier As Date, ligne&)
Dim i&
    For i = ligne + 1 To UBound(arrFacture)
        If IsEmpty(arrFacture(i, 1)) And arrFacture(i, 7) = debRef And arrFacture(i, 8) = finRef Then
            finChantier = arrFacture(i, 12)
            Else: Exit For
        End If
    Next i
    Call ecritureCommentaire(debRef, finRef, debChantier, finChantier, ligneFact)
ligne = i - 1
End Sub

Sub ecritureCommentaire(debRef As Date, finRef As Date, debChantier As Date, finChantier As Date, ligneFact&)
Dim comm$
    comm = "Période du " & debRef & " au " & finRef & " et chantier du " & debChantier
    If Not debChantier = finChantier Then comm = comm & " au " & finChantier
    With Sheets("Feuil1")
        If .Cells(ligneFact, "N").Value = "" Then
            .Cells(ligneFact, "N").Value = comm
            Else
            .Cells(ligneFact, "N").Value = .Cells(ligneFact, "N").Value & Chr(10) & comm
        End If
    End With
End Sub

Bonjour,

Autre proposition via macro associée à Feuil1.

Tu n'as plus que l'embarras du choix.

Salut mes amis!

Alors là je suis comblé!!!

vos méthodes fonctionnent parfaitement!

Un énorme merci pour votre aide et pour le temps que vous allez me faire gagner, je vous en suis très reconnaissant.

bonne journée à tous

Eno

Rechercher des sujets similaires à "ferus vba"