Microsoft 365 Mise à jour cellules du stock

rubis54 · 28 Septembre 2021

Bonjour tout le monde,

Après multiples changements de mon classeur Stock, je pense avoir trouvé quelque chose de plus simple mais trop difficile pour moi en ce qui concerne le VBA pour faire fonctionner cela.

Explications:

A part la feuille "TDB" et "STOCK" il y a 3 feuilles supplémentaires "SORTIE DU JOUR, COMMANDE et ENTREE STOCK"

- sur ces trois feuilles, on se place sur B2 pour taper les premières lettres de l'article recherché et on presse la touche Entrée. Ensuite il affiche en colonne "D" les articles trouvés. On choisit ensuite l'article voulu, on double clique sur l'article et il vient s'afficher dans le tableau à droite(pareil pour les trois feuilles) il ne reste plus qu'a remplir les cellules de la colonne Qté.

Jusqu'ici tout va bien. Lorsque je clique sur "RAZ et Mise à jour stock", il mets à jour uniquement les deux premières lignes de mon stock. Donc même si je choisis un seul article par exemple " tomates " pour la sortie du jour , pour la commande ou pour entrée stock, il mettra à jour la première ligne de mon stock au lieu de mettre à jour la ligne des tomates dans le stock.

Alors est ce quelqu'un pourrai m'aider à rectifier ces erreurs SVP.

Je vous Remercie d'avance.

Rubis54

fanch55 · 29 Septembre 2021

Recherchez une désignation bidon ou avec un stock à zéro .

rubis54 · 29 Septembre 2021

fanch55 à dit:
Salut Jean-Marie,
On se demande parfois si les différents dév d'Office ont un cahier de charge "abouti" avec des spécifs similaires.

Malheureusement,
dès qu'on fait appel à la propriété spécialcells,
on n'aura jamais count=0
car une erreur est tout de suite produite en ce cas .
Ce n'est pas propre indéniablement mais il faut vivre avec ... Regarde la pièce jointe 1116803

OK Jean Marie,
j'ai testé et cela à l'air de fonctionner. Si je choisis par exemple un article avec un stock zéro il ne l'affiche pas.
Super.
C'est vraiment sympa de votre part et de Fanch55 ainsi que Lolote83.
Pour nous c'est pas simple et parfois on pose trop de questions peut-être mais on est obligé, il faut bien que ça rentre
A+

ChTi160 · 29 Septembre 2021

Re
j'ai trouvé cette méthode !
On regarde la Hauteur du DataBodyRange si = à 0 c'est qu'il n'y a pas de ligne Visible !

VB:

If Worksheets("STOCK").ListObjects("Tableau2").DataBodyRange.Height = 0 Then Exit Sub

juste pour le Fun Lol
jean marie

rubis54 · 29 Septembre 2021

ChTi160 à dit:
Re
j'ai trouvé cette méthode !
On regarde la Hauteur du DataBodyRange si = à 0 c'est qu'il n'y a pas de ligne Visible !

VB:

If Worksheets("STOCK").ListObjects("Tableau2").DataBodyRange.Height = 0 Then Exit Sub

juste pour le Fun Lol
jean marie

Je place cette ligne dans la feuille "SORTIE" ?

fanch55 · 29 Septembre 2021

ChTi160 à dit:
On regarde la Hauteur du DataBodyRange si = à 0 c'est qu'il n'y a pas de ligne Visible !

Super Jean-Marie, je n'y avions point pensé
Je vais retenir la formule de contournement précieusement .

@rubis54 : code modifié :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        If [Tableau2[#data]].Height > 0 Then [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
    
End Sub

rubis54 · 29 Septembre 2021

fanch55 à dit:

Super Jean-Marie, je n'y avions point pensé
Je vais retenir la formule de contournement précieusement .

@rubis54 : code modifié :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        If [Tableau2[#data]].Height > 0 Then [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
   
End Sub

Re Fanch55,

j'ai aussi cette proposition pour le code en question.

"Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = [B2].Address Then
Range("D2" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
If [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Rows.Count = 0 Then Exit Sub 'Ici
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If
Sheets("STOCK").Range("A1:F1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Sheets("SORTIE DU JOUR").Range("E1"), Unique:=False
End Sub"

fanch55 · 29 Septembre 2021

rubis54 à dit:
Re Fanch55,

j'ai aussi cette proposition pour le code en question.

If [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Rows.Count = 0 Then Exit Sub 'Ici

Pas bon ...

rubis54 · 29 Septembre 2021

fanch55 à dit:
Pas bon ...

si il fonctionne très bien..

fanch55 · 29 Septembre 2021

Recherchez une désignation bidon ou avec un stock à zéro .

rubis54 · 29 Septembre 2021

fanch55 à dit:
Recherchez une désignation bidon ou avec un stock à zéro .

oui Fanch55, j'ai remarqué aussi ! j'ai vite remis la votre, c'est trés bien comme ça.

Microsoft 365 Mise à jour cellules du stock

rubis54

XLDnaute Occasionnel

Pièces jointes

fanch55

rubis54

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

rubis54

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

rubis54

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

rubis54

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

rubis54

XLDnaute Occasionnel

Discussions similaires