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

Dubuyz1 · 8 Novembre 2024

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 · 8 Novembre 2024

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

Code:

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

Code:

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

Code:

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 · 8 Novembre 2024

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 · 8 Novembre 2024

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 :

Code:

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

Le code :

VB:

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 · 11 Novembre 2024

Bon bah au top ! Merci beaucoup !

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

Dubuyz1

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Dubuyz1

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Dubuyz1

XLDnaute Nouveau

Discussions similaires