Se connecter avec
S'enregistrer | Connectez-vous

[Résolu] For each ne fait pas tout le range

Dernière réponse : dans Programmation

Bonjour a tous,
Je suis nouveau sur le forum, donc je vous souhaite bonne année a tous en retard beaucoup :pt1cable: 

Voici mon problème de macro qui ne fonctionne pas bien. J'ai une liste de produits sérialise indiquant leur état (deinstall, Bad ou stock). La macro que j'utilise pour expédiez les pièces supprime la ligne et l'envoie sur une autres feuille avec (waybill, 3 facture, # bdt etc...)

Bref ca ne fonctionne pas bien car si j'ai 10 produits a expédiez qui sont identifier deinstall ca n'en prend que 5 et je suis obliger d'exécuter a nouveau la macro et cette fois n'en prend que 2. Une image vaut mille mots ... a vous de voir:
  1. Sub Deinstall1()
    

  2. Dim d1 As Range
    

  3. Dim waybill As String
    

  4. waybill = InputBox("# Waybill")
    

  5. For Each d1 In Worksheets("produits").Range("B2:" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address)
    

  6.   If d1.Value = "Deinstall" Then
    

  7.     If d1.Offset(0, 5).Value = "DecisionOne" Then
    

  8.       Worksheets("shipped").Range("A2").EntireRow.Insert
    

  9.       Worksheets("shipped").Range("A2") = d1.Offset(0, 5)
    

  10.       Worksheets("shipped").Range("B2") = d1
    

  11.       Worksheets("shipped").Range("C2") = d1.Offset(0, 1)
    

  12.       Worksheets("shipped").Range("D2") = d1.Offset(0, 2)
    

  13.       Worksheets("shipped").Range("E2") = d1.Offset(0, 3)
    

  14.       Worksheets("shipped").Range("F2") = d1.Offset(0, 4)
    

  15.       Worksheets("shipped").Range("G2") = waybill
    

  16.       Worksheets("shipped").Range("H2") = Now
    

  17.       d1.EntireRow.Delete
    

  18.     End If
    

  19.   End If
    

  20. Next d1
    

  21. End Sub

Autres pages sur : resolu for each fait range

Lassé par la pub ? Créez un compte
Expert Programmation

Et encore un qui ne sait pas supprimer une ligne dans un tableau !

Par ailleurs, très zoli code. Bien que la ligne 5 contienne du ActiveSheet du plus mauvais goût : Et si la feuille active n'est pas Worksheets("produits") ?
Que dis-tu de ça, plutôt :
  1. For Each d1 In Range(Worksheets("produits" ).Range("B2"), _
  2.                       Worksheets("produits" ).Range("B2").SpecialCells(xlCellTypeLastCell))

Tu n'en dis rien, parce que For .. Each n'est pas adapté à une suppression.
Tout est expliqué ici. ;) 

Publie ta solution, si tu trouves. Si tu ne trouves pas, resollicite-nous.

Super merci beaucoup zeb... quoique je ne suis pas encore un :na:  Maintenant je sais ... comment faire :)  

  1. Sub Deinstall1()
    

  2. Dim d1 As Range
    

  3. Dim i As Integer
    

  4. Dim waybill As String
    

  5. waybill = InputBox("# Waybill")
    

  6. For Each d1 In Range(Worksheets("produits").Range("B2"), Worksheets("produits").Range("B2").SpecialCells(xlCellTypeLastCell))
    

  7.   If d1.Value = "Deinstall" Then
    

  8.     If d1.Offset(0, 5).Value = "DecisionOne" Then
    

  9.       Worksheets("shipped").Range("A2").EntireRow.Insert
    

  10.       Worksheets("shipped").Range("A2") = d1.Offset(0, 5)
    

  11.       Worksheets("shipped").Range("B2") = d1
    

  12.       Worksheets("shipped").Range("C2") = d1.Offset(0, 1)
    

  13.       Worksheets("shipped").Range("D2") = d1.Offset(0, 2)
    

  14.       Worksheets("shipped").Range("E2") = d1.Offset(0, 3)
    

  15.       Worksheets("shipped").Range("F2") = d1.Offset(0, 4)
    

  16.       Worksheets("shipped").Range("G2") = waybill
    

  17.       Worksheets("shipped").Range("H2") = Now
    

  18.     End If
    

  19.   End If
    

  20. Next d1
    

  21. For i = Application.WorksheetFunction.CountA(Range("produits!A1:A65536")) To 2 Step -1
    

  22.   If Range("b" & i).Value = "Deinstall" And Range("g" & i).Value = "DecisionOne" Then Rows(i).Delete
    

  23. Next i
    

  24. End Sub

J'ai un autre petit problème avec ce code dans la condition 
  1. If d1.Value = "Deinstall"

et
  1. If d1.Offset(0, 5).Value = "DecisionOne"


Si la case rechercher est écris deinstall ou decisionone ca ne fonctionne pas a cause des majuscules... n'y aurait il pas une facon simple de corriger le problème. Peut etre en marquant .text au lieu de .value ?
Expert Programmation

Pour ton dernier problème, et quelque soit le langage, voici la solution, évidente quand tu l'auras lue :
  1. Si Majuscule ( Variable ) = "VALEUR" Alors ...
  2. Si Minuscule ( Variable ) = "valeur" Alors ...
  3. Si Majuscule ( Variable1 ) = Majuscule ( Variable2 ) Alors ...
  4. Si Minuscule ( Variable1 ) = Minuscule ( Variable2 ) Alors ...


Mais peut-être as-tu déjà trouvé, le temps que je te réponde.
_______________________________________________________________________

Quant à ta solution, quelle horreur. Je ne parle pas de la maîtrise du langage, mais de l'algorithme. Pouah !!
En plus il reste des erreurs.

Tu l'as ta zone, tu la définis ligne 7 ! Qu'est-ce que tu nous fais ligne 21 ?
Je te rappelle que CountA c'est la fonction NBVAL, et que si tu as un trou dans ta liste, ta boucle est fausse.
Et puis pourquoi deux boucles. Une seule suffit !

Et encore une remarque sous forme de devinettes :
  • Combien y-a-t-il de ligne dans une feuille XL ?
  • Entre quelles valeurs, la valeur d'un entier de type Integer est-elle comprise ?

    Ah, j'oubliais. Partout, tu précises la feuille sur laquelle tu travailles. C'est très bien. Comme ça, pas de select, d'activate ou de ce genre de choses qui ralentissent le programme ou qui supposent que l'on doit être dans tel cas particulier pour que ça marche. Sauf que ligne 22, tu l'oublies ! (En plus, c'est au moment de la suppression des lignes. Si tu veux perdre tes données, c'est comme ça qu'il faut faire).

    Regarde :
    1. Dim ws_s As  Worksheet
    2. Dim ws_p As  Worksheet
    3. Dim rg_s As  Range
    4. Dim rg_p As  Range
    5. Dim r        As Long
    6. Dim last_row As Long
    7.  
    8. Set ws_s = Worksheets("shipped" )
    9. Set ws_p = Worksheets("produits" )
    10.  
    11. ' // S'il ne doit pas y avoir de trou entre la première valeur et la dernière :
    12. last_row = ws_p.Range("B2" ).End(xlDown).Row
    13. ' // S'il peut y avoir des trous :
    14. last_row = ws_p.Range("B65536" ).End(xlUp).Row
    15.  
    16. For r = last_row To 2 Step -1
    17.   If Lcase(ws_p.Range("B" & r).Value) = "deinstall" And _
    18.      UCase(ws_p.Range("G" & r).Value) = "DECISIONONE" Then
    19.       ws_s.Range("A2").EntireRow.Insert
    20.  
    21.       Set rg_p = ws_p.Range("B" & r)
    22.       Set rg_s = ws_s.Range("A2")
    23.  
    24.       ws_s.Range("A2").Value = rg_p.Offset(, 5).Value
    25.       ws_s.Range("B2").Value = rg_p.Offset(, 0).Value
    26.       ws_s.Range("C2").Value = rg_p.Offset(, 1).Value
    27.       ws_s.Range("D2").Value = rg_p.Offset(, 2).Value
    28.       ws_s.Range("E2").Value = rg_p.Offset(, 3).Value
    29.       ws_s.Range("F2").Value = rg_p.Offset(, 4).Value
    30.       ws_s.Range("G2").Value = waybill
    31.       ws_s.Range("H2").Value = Now
    32.  
    33.       rg_p.EntireRow.Delete
    34.   Enf If
    35. Next

    Bon, c'est pas mal, qu'est-ce que t'en penses ?

    Moi, je suis un gros fainéant. Je n'aime pas écrire six fois la même chose.
    Alors je réécris les lignes 22 à 29 :
    1. Set rg_s = ws_s.Range("A2")
    2.  
    3. rg_s.Offset(, 0).Value = rg_p.Offset(, 5).Value
    4. rg_s.Offset(, 1).Value = rg_p.Offset(, 0).Value
    5. rg_s.Offset(, 2).Value = rg_p.Offset(, 1).Value
    6. rg_s.Offset(, 3).Value = rg_p.Offset(, 2).Value
    7. rg_s.Offset(, 4).Value = rg_p.Offset(, 3).Value
    8. rg_s.Offset(, 5).Value = rg_p.Offset(, 4).Value


    1. Set rg_s = ws_s.Range("A2")
    2. For i = 0 To 5                     
    3.   rg_s.Offset(, i) = rg_p.Offset(, (i + 5) Mod 6 )
    4. Next
    5. rg_s.Offset(, 6).Value = waybill
    6. rg_s.Offset(, 7).Value = Now


    Une dernière chose.
    La méthode Range peut accepter une chaîne de caractères et on peut construire l'adresse comme ceci :
    1. rg_p = ws_p.Range("B" & r)
    Ce qui est plus sympa, à première vue, que cela :
    1. rg_p = ws_p.Cells(r, 2)
    Mais s'habituer à la notation (Ligne,Colonne) a l'avantage d'être plus facile à traiter avec des nombres, dans des boucles, par exemple. La preuve, c'est que tant que c'est la ligne qui varie, c'est sympa, mais si c'était sur la colonne qu'il fallait itérer, ferais-tu des choses comme ça :
    1. For colonne = 1 To 10
    2.   Range(Chr(colonne+64)) ..
    3. Next
    Surtout pas, parce que le suivant de 'Z', c'est 'AA' pour Excel, et non pas '[' pour l'Ascii.


    On reprend le tout :
    1. Dim ws_s As  Worksheet
    2. Dim ws_p As  Worksheet
    3. Dim rg_s As  Range
    4. Dim rg_p As  Range
    5. Dim r        As Long
    6. Dim i        As Long
    7. Dim last_row As Long
    8.  
    9. Set ws_s = Worksheets("shipped")
    10. Set ws_p = Worksheets("produits")
    11.  
    12. ' // S'il ne doit pas y avoir de trou entre la première valeur et la dernière :
    13. last_row = ws_p.Cells(2, 2).End(xlDown).Row
    14. ' // S'il peut y avoir des trous :
    15. last_row = ws_p.Cells(65536, 2).End(xlUp).Row
    16.  
    17. For r = last_row To 2 Step -1
    18.   If Lcase(ws_p.Cells(r, 2).Value) = "deinstall" And _
    19.      UCase(ws_p.Cells(r, 7).Value) = "DECISIONONE" Then
    20.       ws_s.Cells(2, 1).EntireRow.Insert
    21.  
    22.       Set rg_p = ws_p.Cells(r, 2)
    23.       Set rg_s = ws_s.Cells(2, 1)
    24.  
    25.       For i = 0 To 5                     
    26.         rg_s.Offset(, i) = rg_p.Offset(, (i + 5) Mod 6)
    27.       Next
    28.  
    29.       rg_s.Offset(, 6).Value = waybill
    30.       rg_s.Offset(, 7).Value = Now
    31.  
    32.       rg_p.EntireRow.Delete
    33.   Enf If
    34. Next


    TADAAA!

    Tu déchires zeb!! ABRACADABRA ... C'est magique! Ca fonctionne #1 et beaucoup plus rapide. Merci beaucoup

    Tu as tout fais pour moi avec des explication en plus WAW :)  Il y a quand meme une ligne que je comprend pas trop, ca fais une semaine que je me suis au VBA, anciennement mirc scripting alors j'en arrache encore.

    1. For i = 0 To 5                   
      

    2.          rg_s.Offset(, i) = rg_p.Offset(, (i + 5) Mod 6)
      

    3.        Next


    mod6 c'est quoi au juste ?
    Expert Programmation

    Bon, je t'avoue que je m'emmerde un peu au boulot. Et pis ce n'est pas mon habitude que de tout donner tout fait. Par contre, tu semblais avoir de très bonnes bases (le langage en lui-même est bien utilisé je trouve, c'est rare avec le VBA) et je sentais que tu allais lire et comprendre ce que je te proposais avant de l'accepter et de l'utiliser, au contraire de certains qui l'auraient pris sans se poser de questions. J'ai la preuve que tu l'as lu, puisque tu poses une question pertinente. Ça fait plaisir :) 

    Spa de la programmation, ce sont des maths !

    1. rg_s.Offset(, 0).Value = rg_p.Offset(, 5).Value
    2. rg_s.Offset(, 1).Value = rg_p.Offset(, 0).Value
    3. rg_s.Offset(, 2).Value = rg_p.Offset(, 1).Value
    4. rg_s.Offset(, 3).Value = rg_p.Offset(, 2).Value
    5. rg_s.Offset(, 4).Value = rg_p.Offset(, 3).Value
    6. rg_s.Offset(, 5).Value = rg_p.Offset(, 4).Value

    Quand un code ressemble à ça, moi, je ne vois que ça :
    0 -> 5
    1 -> 0
    2 -> 1
    3 -> 2
    4 -> 3
    5 -> 4
    Et je me demande quelle fonction f associe 0 à 5, 1 à 0, 2 à 1, etc.

    Ben figure-toi que la fonction
    f : N -> N
    f(x) = (x + 5) - (x + 5) / 6
    correspond très bien.

    Rappelle-toi ce qu'est une division entière : c'est un dividende A, un divideur B, un quotient Q, et un reste R.
    . A | B
    ... +--
    . R | Q


    Et bien en mathématique, il existe une fonction qui associe (A,B) à R, on l'appelle Modulo.

    La fonction f s'écrit :
    f : N -> N
    f(x) = (x + 5) Modulo 6


    La fonction Modulo est très pratique pour les permutations circulaires.
    En VB, elle s'écrit Mod, en C/C++, c'est %.

    Aaaah j'ai juste pas été a l'école assez longtemps pour connaitre la fonction modulo. T'es un bon professeur, j'ai tout compris ton code maintenant. Ca m'énerve faire quelque chose sans savoir pourquoi. Je t'apporte une pomme demain... promis ;) 

    Et de plus ce n'est qu'une partie de mon code que j'ai apporter ici, donc en comprennent parfaitement ce code très optimisé je devrais être en mesure de optimiser le reste de mon code, qui doit comporter encore des bugs importants.

    Histoire de protéger mon orgueil démesurer, je vais tenter de pas écrire un nouveau sujet concernant le reste de mon code. Merci beaucoup zeb !!!
    Expert Programmation

    baal28 a dit :
    T'es un bon professeur
    T'est un bon élève !
    baal28 a dit :
    Je t'apporte une pomme demain... promis ;) 
    :D 

    N'hésite pas pas à poser des questions, ou à solliciter un peu d'aide. Avec l'esprit critique que certains ont ici, tu obtiendras en plus d'une solution, des remarques, des critiques, des objections qui peuvent te faire apprendre et progresser. T'avais rien demandé, et pourtant, tu connais maintenant Modulo ;) 
    Lassé par la pub ? Créez un compte

    Créer un nouveau sujet