Microsoft 365 Job75 et pour les curieux

[blancolie]

Bonjour Job75

Voila, je reviens vers toi, ayant fait le tour de mes questions sur mes différents discussions sur les différentes possibilités de recherche( index, equiv, petite valeur etc)

et faut avoir plusieurs cordes à son arc.

Merci pour ton apport pour les autres discussions et solutions apportées. Mon but c'est d'avoir des solutions et de les comprendre pour les refaire soit-même sinon.

Donc je suis prêt à étudier le VBA en espérant avoir la capacité mentalement de comprendre ce langage qui certe nous facilite le travail.

Je reviens sur le fichier ci dessous :

J'aimerais savoir si on peut encore l'améliorer.

Actuellement ce codage permet faire des recherches par fournisseurs, de rentrer les quantités et leurs destinations (massif/secteur :ex plates bandes Musée Lambinet - Secteur hoche) et par le bouton de copier mes choix dans les onglets appropriés. Voila le résumé.

Par contre, je peux avoir la même plante avec des quantités différentes dans plusieurs secteurs. Peut on avoir la possibilté devant une plante avoir plusieurs choix : 9 Secteurs donc 9 Choix et qu'on puisse rentrer la quantité associé ?

J'espère avoir été clair, n'hésite pas à me poser des questions.

Tu as crée un champ :"plante" par contre peut on être plus pointilleux ? c'est à dire qu'une seule lettre et qu'on voit que les plantes associées à la lettre ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:E]) Is Nothing Then Exit Sub
Dim critere$, tablo, resu(), i&, n&
Application.EnableEvents = False 'désactive les évènements
If [B2] = "" Then [C2] = "": GoTo 1
If Not Intersect(Target, [B2]) Is Nothing Then [C2] = ""
critere = LCase([B2] & Chr(1) & "*" & CStr([C2])) & "*"
tablo = Sheets("BDD_Technique").[A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 6)
For i = 2 To UBound(tablo)
    If LCase(tablo(i, 3) & Chr(1) & tablo(i, 1)) Like critere Then
        n = n + 1
        resu(n, 1) = tablo(i, 3)
        resu(n, 2) = tablo(i, 1)
        resu(n, 3) = tablo(i, 4)
        resu(n, 4) = tablo(i, 5)
    End If
Next
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [B5] '1ère cellule de restitution
     If n Then .Resize(n, 6) = resu
     .Offset(n).Resize(Rows.Count - n - .Row + 1, 6).ClearContents 'RAZ en dessous
End With
Columns(3).AutoFit 'ajustement largeur
ActiveWindow.ScrollRow = 1 'cadrage
With UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub Transfert()
Dim n&, w As Worksheet
With [A4].CurrentRegion.Resize(, 7)
    n = Application.CountIf(.Columns(6), ">0")
    If [B2] = "" Or n = 0 Then Exit Sub
    If MsgBox("Transférer " & n & " ligne" & IIf(n = 1, " ?", "s ?"), 36, "Transfert vers " & [B2]) = 7 Then Exit Sub
    Application.ScreenUpdating = False
    Set w = Sheets("Devis " & [B2]) 'feuille du fournisseur
    .AutoFilter 6, ">0" 'filtre automatique
    Intersect(Range("C5:G" & Rows.Count), .Cells).Copy w.Cells(w.Rows.Count, 2).End(xlUp)(2) 'copier-coller
    .AutoFilter 'désactive le filtre
End With
w.Columns(2).AutoFit 'ajustement largeur
w.Columns(6).AutoFit 'ajustement largeur
w.Activate
[B2] = "" 'RAZ
End Sub

Sub RAZ()
'---pour les feuilles des devis---
With ActiveSheet
    If .Name Like "Devis*" Then .Range("B3:F" & .Rows.Count).Delete xlUp
End With
End Sub

Merci

 

[blancolie]

Bonjour,

personne pour apporter les améliorations . Désolé , je n'y connais rien du tout au vba