Remplacement d'une valeur dans une cellule
Résoluisa-- Messages postés 82 Date d'inscription lundi 16 septembre 2013 Statut Membre Dernière intervention 20 décembre 2024 - 20 déc. 2024 à 16:12
- Remplacement d'une valeur dans une cellule
- Coco chat remplacement - Accueil - Réseaux sociaux
- Aller à la ligne dans une cellule excel - Guide
- Remplaçant de Coco : quelles solutions pour tchater gratuitement en ligne ? - Accueil - Réseaux sociaux
- Excel cellule couleur si condition texte - Guide
- Verrouiller une cellule excel - Guide
8 réponses
19 déc. 2024 à 18:42
bonjour,
Je pense que tu dois supprimer la boucle "For i = 0 To 10". Tu n'as pas besoin de tous ces tableaux ref, row, QteVendue, QteStock, et tu n'as pas besoin de i.
Pour faciliter la lecture et éviter des erreurs, il est recommandé de mettre l'indice de boucle dans le "Next": "next cell", "next cell2".
20 déc. 2024 à 07:02
Merci de ta réponse
Je note bien l'astuce pour les "next", c'est bien pratique en effet, merci
Tu noteras que je débute carrément en vba... Tu penses que ca pourrait être fait plus facilement ?
En gros, je dois, pour toutes les lignes de facture, ôter la quantité vendue de la valeur en stock. Peux tu m'aiguiller un peu ? Je n'ai trouvé que la solution des boucles, mais si tu as plus simple, je suis preneuse !
Merci d'avance !
20 déc. 2024 à 14:53
La solution des boucles peut fonctionner, mais tu as fait trois boucles, alors que deux suffisent:
Sub boucle() Dim derniereligne As Long Dim ref Dim QteVendue Dim plage As Range 'plage de recherche Dim QteStock 'Quantité en stock 'compter les cellules non vides du stock derniereligne = ThisWorkbook.Worksheets("Feuil1").Cells(ThisWorkbook.Worksheets("Feuil1").Rows.Count, 10).End(xlUp).row Set plage = ThisWorkbook.Worksheets("Feuil1").Range("I1:I" & derniereligne) ' plage de recherche de la ref Dim cell As Range Dim cell2 As Range For Each cell In ThisWorkbook.Worksheets("Feuil1").Range("E1:E10") ' pour toutes les cellules non vides de la plage ref de facture If cell <> "" Then ref = cell ' recherche quantité vendue QteVendue = cell.Offset(, 1) For Each cell2 In plage 'pour toutes les cellules de la feuille de stock If cell2.Value = ref Then 'quantité en stock QteStock = cell2.Offset(, 1) ' nouvelle quantité en stock QteStock = QteStock - QteVendue cell2.Offset(, 1) = QteStock ' fonctionne maintenant 'Range("K" & row(i)).Value = QteStock(i) 'fonctionne mais à côté Exit For End If Next cell2 End If Next cell End Sub
20 déc. 2024 à 08:19
Bonjour a tous
Une facon de faire.
Par contre si vous avez beaucoup de valeur colonne D ou/et Colonne I, il y a une autre facon de coder pour avoir un temps d'execution plus rapide
Sub Boucle() Dim PlageRefStock As Range, PlageRefFacture As Range Dim NbL As Long, LStock As Long With Worksheets("Feuil1") Set PlageRefStock = .Range("I1:I" & .Range("I" & Rows.Count).End(xlUp).row) ' plage ref Stock Set PlageRefFacture = .Range("D3:D" & .Range("E" & Rows.Count).End(xlUp).row) 'plage ref Facture End With NbL = PlageRefFacture.Count 'nombre de valeur dans colonne D For n = 1 To NbL LStock = Application.Match(PlageRefFacture(n, 1), PlageRefStock, 0) If LStock > 0 Then PlageRefStock(LStock, 1).Offset(, 1) = PlageRefStock(LStock, 1).Offset(, 1) - PlageRefFacture(n, 1).Offset(, 1) 'majour Stock colonne J Else MsgBox "Attention: " & PlageRefFacture(n, 1) & " n'existe pas ou " & PlageRefStock & " n'existe pas !!" End If Next n End Sub
20 déc. 2024 à 08:26
Ca a l'air top !
Mille mercis !
Je vais le tester de suite.
Super sympa parce que j'y ai passé un temps fou pour un résultat pas satisfaisant.
Bonne journée à toi !
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question20 déc. 2024 à 12:00
Hélas j'ai une erreur d'execution 13 : Imcompatibilité de type
sur la ligne
LStock = Application.Match(PlageRefFacture(n, 1), PlageRefStock, 0)
et je ne vois pas pourquoi. Une idée ? merci mille fois
Modifié le 20 déc. 2024 à 14:14
Une idée:
Option Explicit Sub Boucle() Dim PlageRefStock As Range, PlageRefFacture As Range Dim NbL As Long, LStock, n With Worksheets("Feuil1") Set PlageRefStock = .Range("I1:I" & .Range("I" & Rows.Count).End(xlUp).Row) ' plage ref Stock Set PlageRefFacture = .Range("e3:e" & .Range("E" & Rows.Count).End(xlUp).Row) 'plage ref Facture End With NbL = PlageRefFacture.Count 'nombre de valeur dans colonne D For n = 1 To NbL LStock = Application.Match(PlageRefFacture(n, 1), PlageRefStock, 0) If IsNumeric(LStock) Then PlageRefStock(LStock, 1).Offset(, 1) = PlageRefStock(LStock, 1).Offset(, 1) - PlageRefFacture(n, 1).Offset(, 1) 'majour Stock colonne J Else MsgBox "Attention: facture " & PlageRefFacture(n, 1) & " n'existe pas." End If Next n End Sub
20 déc. 2024 à 13:42
Re,
Les idees, ce n'est pas ce qui manque.
Avec votre fichier ce serait vraiment plus simple pour vous repondre
Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com
Allez sur ce site : http://cjoint.com
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
20 déc. 2024 à 14:49
Re,
En attendant, un peu plus de controles.
pour les msgbox, a vous de sophistiquer
Sub Boucle() Dim PlageRefStock As Range, PlageRefFacture As Range Dim NbL As Long, LStock With Worksheets("Feuil1") Set PlageRefStock = .Range("I1:I" & .Range("I" & Rows.Count).End(xlUp).row) ' plage ref Stock Set PlageRefFacture = .Range("D3:D" & .Range("E" & Rows.Count).End(xlUp).row) 'plage ref Facture End With NbL = PlageRefFacture.Count 'nombre de valeur dans colonne D For n = 1 To NbL LStock = Application.Match(PlageRefFacture(n, 1), PlageRefStock, 0) If IsNumeric(LStock) Then If IsNumeric(PlageRefStock(LStock, 1).Offset(, 1)) And IsNumeric(PlageRefFacture(n, 1).Offset(, 1)) Then PlageRefStock(LStock, 1).Offset(, 1) = PlageRefStock(LStock, 1).Offset(, 1) - PlageRefFacture(n, 1).Offset(, 1) 'majour Stock colonne J Else MsgBox "Attention: " & PlageRefFacture(n, 1) & " ==> " & PlageRefStock(LStock, 1).Offset(, 1) & " ou " & PlageRefFacture(n, 1).Offset(, 1) & " pas un numeric " End If Else MsgBox "Attention: " & PlageRefFacture(n, 1) & " n'existe pas !!" End If Next n End Sub
20 déc. 2024 à 16:12
Bon, avec de l'aide, d'autre part, j'ai une solution, je vous la mets ci dessous si quelqu'un avait un jour la même problématique :
Résumé du problème : mettre à jour des quantités en stock à l'établissement d'une facture
Hypothèses :
La colonne A de la feuille "facture" contient les références, et la colonne B contient les quantités vendues.
La colonne A de la feuille "stock" contient les références, et la colonne B contient les quantités en stock.
Les en-têtes sont sur la première ligne des deux feuilles.
Sub MettreAJourStock() Dim wsFacture As Worksheet, wsStock As Worksheet Dim lastRowFacture As Long, lastRowStock As Long Dim refFacture As String Dim qteVendue As Double Dim foundCell As Range Dim i As Long ' Associer les feuilles Set wsFacture = ThisWorkbook.Sheets("facture") Set wsStock = ThisWorkbook.Sheets("stock") ' Trouver le dernier numéro de ligne pour chaque feuille lastRowFacture = wsFacture.Cells(wsFacture.Rows.Count, 1).End(xlUp).Row lastRowStock = wsStock.Cells(wsStock.Rows.Count, 1).End(xlUp).Row ' Parcourir chaque ligne de la facture For i = 2 To lastRowFacture ' On suppose que la ligne 1 contient les en-têtes refFacture = wsFacture.Cells(i, 1).Value ' Colonne A : Référence qteVendue = wsFacture.Cells(i, 2).Value ' Colonne B : Quantité vendue ' Rechercher la référence dans la feuille "stock" Set foundCell = wsStock.Columns(1).Find(What:=refFacture, LookIn:=xlValues, LookAt:=xlWhole) If Not foundCell Is Nothing Then ' Référence trouvée : mettre à jour la quantité en stock If foundCell.Offset(0, 1).Value >= qteVendue Then foundCell.Offset(0, 1).Value = foundCell.Offset(0, 1).Value - qteVendue Else MsgBox "Stock insuffisant pour la référence : " & refFacture, vbExclamation End If Else ' Référence non trouvée MsgBox "La référence " & refFacture & " n'existe pas dans le stock.", vbCritical End If Next i MsgBox "Mise à jour du stock terminée.", vbInformation End Sub
Merci à tous ceux qui se sont penchés sur le problème
Bonne soirée