Remplacement d'une valeur dans une cellule

Résolu
isa-- Messages postés 83 Statut Membre -  
isa-- Messages postés 83 Statut Membre -

Bonjour,

Je tente de faire une macro qui va modifier des  stocks suite à une facture.

Tout fonctionne à merveille si je fais écrire la nouvelle valeur de stock dans une colonne différente de celle de la valeur initiale. Si je tente de mettre à jour la valeur initiale (écrire dans la même cellule), ca ne fonctionne pas, cela fait le traitement non pas une fois mais autant de fois qu'il y a de lignes... Je ne comprends pas du tout

Pouvez vous m'aider ? Merci d'avance

Voici mon code :

Sub boucle()
'
' boucle Macro

Dim i As Integer
Dim ref(10)
Dim QteVendue(10)
Dim plage As Range 'plage de recherche
Dim QteStock(10) 'Quantité en stock
'compter les cellules non vides du stock
derniereligne = Cells(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
Dim col
Dim row(10)
ligne = 0

For Each cell In Feuil1.Range("E1:E10") ' pour toutes les cellules non vides de la plage ref de facture
                If cell <> "" Then
                ligne = ligne + 1
                'Enregistrement des valeurs dans le tableau REFERENCE et quantité
                    For i = 0 To 10
                    ref(i) = Range("E" & i + 2)
                    ' recherche quantité vendue
                    QteVendue(i) = Range("F" & i + 2)
                    '*******************************************
        For Each cell2 In plage 'pour toutes les cellules de la feuille de stock
            If cell2.Value = ref(i) Then
            ' contruction adresse cellule stock
            row(i) = Split(cell2.Address, "$")(2)
            'quantité en stock
            QteStock(i) = Range("J" & row(i)).Value
            ' nouvelle quantité en stock
             QteStock(i) = QteStock(i) - QteVendue(i)
            ' Range("J" & row(i)).Value = QteStock(i) 'ne fonctionne pas
            Range("K" & row(i)).Value = QteStock(i) 'fonctionne mais à côté
                                        
             End If
                            
        Next
    '***************************************
            Next
                End If
Next
'MsgBox "ligne stock" & row(4)
'MsgBox "new stock " & QteStock(4)
End Sub

Voici mon fichier excel :


Windows / Firefox 133.0

8 réponses

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     

    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".

    0
  2. isa-- Messages postés 83 Statut Membre 1
     

    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 !

    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       

      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
      0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     

    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
    
    0
  4. isa-- Messages postés 83 Statut Membre 1
     

    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 !

    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. isa-- Messages postés 83 Statut Membre 1
     

    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

    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       

      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
      
      0
  7. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     

    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...

    0
  8. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     

    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
    
    0
  9. isa-- Messages postés 83 Statut Membre 1
     

    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

    0