XL 2021 3 problèmes : Bouton VBA (fusion et suppression) & doublons

[Dubuyz1]

Bonjour,
Je ne suis pas grand connaisseur dans le domaine et mon patron m'a chargé d'une mission : refaire son tableau d'enregistrement de commandes.
J'ai refait beaucoup de choses (si ce n'est pas tout son tableau) mais, à la fin de l'exercice, je me retrouve bloqué face à 3 problèmes.

Le premier : J'ai plusieurs entreprises, dont certaines sont les mêmes, juste à des localisations différentes. Afin d'harmoniser les prix pour le groupe, le calcul du transport se base sur l'entreprise la plus loin. C'est-à-dire que je cherche une fonction qui me permettrait de dire : SI(plusieurs fois la même entreprise;km le plus loin;km de cette entreprise). Je ne sais pas si j'ai été très clair, de toutes façons, je le réexplique dans la feuille 1 du tableur en pièce jointe.

Le deuxième, lorsque je récapitule la commande de l'entreprise, il y a plusieurs lignes qui se mettent les unes sous les autres. J'aurais besoin d'un bouton VBA afin que le nom de l'entreprise (en début de ce tableau), se fusionne avec les ligne en dessous afin qu'il soit devant toutes les lignes de la commande. Idem, si je n'ai pas été très clair, je l'ai expliqué dans la feuille 2.

Le troisième, c'est l'inverse. Lorsque je fais la facture, j'aurais besoin d'un bouton VBA qui fasse en sorte de supprimer les lignes inutiles afin de ne pas avoir des factures à rallonge. Encore une fois, vous trouverez l'explication dans la feuille 3 du tableur.

Voilà, j'espère que vous réussirez à m'aider !
Je vous remercie d'avance !

 

[sylvanu]

Bonjour Dubuyz,
Un essai en PJ pour les 3 soucis :

Sub km()
Dim Tablo, i%, j%, KmMax, Entreprise$
Tablo = [A1].CurrentRegion
For i = 2 To UBound(Tablo)
    Entreprise = Split(Tablo(i, 1), " ")(0)
    KmMax = 0
    For j = 2 To UBound(Tablo)
        If Tablo(j, 1) Like Entreprise & "*" Then
            KmMax = Application.Max(KmMax, Tablo(j, 2))
        End If
    Next j
    Tablo(i, 3) = KmMax
Next i
[A1].Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
End Sub

Sub Fusionner()
Dim DL%, Lig%, C%
DL = [G1000].End(xlUp).Row
For Lig = 3 To DL
    If Cells(Lig, "F") = "" And Cells(Lig, "G") <> "" Then C = Lig
Next Lig
Range(Cells(2, "F"), Cells(C, "F")).MergeCells = True
Range(Cells(2, "I"), Cells(C, "I")).MergeCells = True
[F2].VerticalAlignment = xlCenter
[I2].VerticalAlignment = xlCenter
End Sub

Sub EffacerLignesVidesFacture()
Dim DL%, Début%
DL = [E1000].End(xlUp).Row
For Lig = DL - 1 To 4 Step -1
    If Cells(Lig, "E") = "" Then Début = Lig
Next Lig
Range("E" & Début & ":G" & DL - 1).Delete Shift:=xlUp
End Sub

 

[Dubuyz1]

Au top pour les 2ème et 3ème problèmes ! Pour le premier, il me faudrait juste une formule, pas une macro si possible !

Merci pour tout !

 

[sylvanu]

Re,
Par formules XL cela va être une usine à gaz, je vous propose une fonction perso en VBA puisque vous en avez.
La syntaxe est :

=km(Entreprise;Plage)
par ex :
=km(A2;$A$2:$B$7)

Le code :

Function km(Nom, Plage)
Dim Tablo, i%, j%, KmMax, Entreprise$
Tablo = Plage
Entreprise = Split(Nom, " ")(0)
KmMax = 0
For j = 2 To UBound(Tablo)
    If Tablo(j, 1) Like Entreprise & "*" Then
        KmMax = Application.Max(KmMax, Tablo(j, 2))
    End If
Next j
km = KmMax
End Function

 

[Dubuyz1]

Bon bah au top ! Merci beaucoup !