Microsoft 365 Creation de boucle

F

Faroyo

XLDnaute Junior
Bonjour,
j'ai besoin de votre aide pour solutionner mon problème.
Je voudrais étendre un bout de code et je rame .
Voici ce bout de code.
Je voudrais pouvoir l’étendre jusqu’à la dernière cellule remplie de la colonne "G".


If UCase(Range("G4").Value) Like "*ISO*" Then
Range("O4").Value = Range("N4") + 1000
ElseIf UCase(Range("G4").Value) Like "*IBC*" Then
Range("O4").Value = Range("N4") + 500
ElseIf UCase(Range("G4").Value) Like "*SAC*" Then
Range("O4").Value = Range("N4")
ElseIf UCase(Range("G4").Value) Like "*BAG*" Then
Range("O4").Value = Range("N4")
ElseIf UCase(Range("G4").Value) Like "*ISOMIX*" Then
Range("O4").Value = Range("N4")
ElseIf UCase(Range("G4").Value) Like "*GEL*" Then
Range("O4").Value = Range("N4")
ElseIf UCase(Range("G4").Value) Like "*FUT*" Then
Range("O4").Value = Range("N4")
ElseIf UCase(Range("G4").Value) Like "*POUDRE*" Then
Range("O4").Value = Range("N4")
ElseIf UCase(Range("G4").Value) Like "*JERRYCAN*" Then
Range("O4").Value = Range("N4")
ElseIf UCase(Range("G4").Value) Like "*V5700*" Then
Range("O4").Value = Range("N4")

Merci pour votre aide.
 
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Faroyo,
essayez d'utiliser les balises </> pour le code, cela le rend plus lisible.
sans autre explications, et sans fichier test, c'est un peu au pif.
Une solution possible si tant est que j'ai tout compris :
VB: 
Sub test()
' on déclare un tableau avec toutes les chaines recherchées
Chaine = Array("ISO", "IBC", "SAC", "BAG", "ISOMIX", "GEL", "FUT", "POUDRE", "JERRICAN", "V5700")
' on déclare un tableau avec toutes les valeurs à ajouter à N4
N = Array(1000, 500, 0, 0, 0, 0, 0, 0, 0, 0, 0)
' taille de l'array
Taille = UBound(Chaine)
' nombre de cellules occupéres en colonne G
TailleG = Application.CountIf(Range("G:G"), "*")
' pour toutes les lignes de G
For Ligne = 1 To TailleG
    ' on prend la valeur en G de la ligne concernée
    Valeur = UCase(Range("G" & Ligne).Value)
    ' pour toutes les chaines recherchées
    For i = 0 To Taille
        ' si la cellule
        If Valeur Like "*" & Chaine(i) & "*" Then
            ' on met valeur col N dans col O additionné de la valeur de l'array N.
            Range("O" & Ligne).Value = Range("N" & Ligne) + N(i)
        End If
    Next i
Next Ligne
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
_Thierry

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @Faroyo , le Forum

Un exemple de base de boucle sur ton code :

VB: 
Option Explicit

Sub MyBoucle()
Dim WSsource As Worksheet
Dim PlageSource As Range, CellSource As Range

Set WSsource = ThisWorkbook.Worksheets("Sheet1")

Set PlageSource = WSsource.Range("G4:G" & WSsource.Range("G1000").End(xlUp).Row)


    For Each CellSource In PlageSource
    
        If UCase(CellSource.Value) Like "*ISO*" Then
            CellSource.Offset(0, 8) = CellSource.Offset(0, 7) + 1000
        ElseIf UCase(CellSource.Value) Like "*IBC*" Then
            CellSource.Offset(0, 8) = CellSource.Offset(0, 7) + 500
        ElseIf UCase(CellSource.Value) Like "*SAC*" Then
            CellSource.Offset(0, 8) = CellSource.Offset(0, 7)
        'ETC  ................
        End If
    Next CellSource

End Sub

Bonne journée
@+Thierry
 
Vote positif 0 Vote négatif
J

jmfmarques

XLDnaute Accro
Bonjour à tous
J'essaierais ceci (écrit à main levée et non testé) :
VB: 
derlig = Range("G" & Rows.Count).End(xlUp).Row
toto = array("*ISO*", "*IBC*", "*SAC*", "*BAG*", "*ISOMIX*", "*GEL*", "*FUT*", "*POUDRE*", "*JERRYCAN*", "*JERRYCAN*", "*V5700*")
For k = 4 To derlig
  PLUS = 0
  For n = 0 To uBound(toto)
    if ucase(range("G" & k).value) like toto(n) then  exit for
  next
  select case n
    case 0: PLUS = 1000
    case 1: PLUS = 100
  end select
  range("O" & k).value = range("N" & k).value + PLUS
next
 
Vote positif 0 Vote négatif
F

Faroyo

XLDnaute Junior
jmfmarques à dit:
Bonjour à tous
J'essaierais ceci (écrit à main levée et non testé) :
VB: 
derlig = Range("G" & Rows.Count).End(xlUp).Row
toto = array("*ISO*", "*IBC*", "*SAC*", "*BAG*", "*ISOMIX*", "*GEL*", "*FUT*", "*POUDRE*", "*JERRYCAN*", "*JERRYCAN*", "*V5700*")
For k = 4 To derlig
  PLUS = 0
  For n = 0 To uBound(toto)
    if ucase(range("G" & k).value) like toto(n) then  exit for
  next
  select case n
    case 0: PLUS = 1000
    case 1: PLUS = 100
  end select
  range("O" & k).value = range("N" & k).value + PLUS
next
Cliquez pour agrandir...

Bonjour jmfmarques,
je viens de tester ton code.
le remplissage du tableau se fait parfaitement mais il bloque ensuite sur la dernière ligne
range("O" & k).value = range("N" & k).value + PLUS
"Run-time error "13".
Une idee du pourquoi du comment?
Merci
 
Vote positif 0 Vote négatif
F

Faroyo

XLDnaute Junior
sylvanu à dit:
Bonjour Faroyo,
essayez d'utiliser les balises </> pour le code, cela le rend plus lisible.
sans autre explications, et sans fichier test, c'est un peu au pif.
Une solution possible si tant est que j'ai tout compris :
VB: 
Sub test()
' on déclare un tableau avec toutes les chaines recherchées
Chaine = Array("ISO", "IBC", "SAC", "BAG", "ISOMIX", "GEL", "FUT", "POUDRE", "JERRICAN", "V5700")
' on déclare un tableau avec toutes les valeurs à ajouter à N4
N = Array(1000, 500, 0, 0, 0, 0, 0, 0, 0, 0, 0)
' taille de l'array
Taille = UBound(Chaine)
' nombre de cellules occupéres en colonne G
TailleG = Application.CountIf(Range("G:G"), "*")
' pour toutes les lignes de G
For Ligne = 1 To TailleG
    ' on prend la valeur en G de la ligne concernée
    Valeur = UCase(Range("G" & Ligne).Value)
    ' pour toutes les chaines recherchées
    For i = 0 To Taille
        ' si la cellule
        If Valeur Like "*" & Chaine(i) & "*" Then
            ' on met valeur col N dans col O additionné de la valeur de l'array N.
            Range("O" & Ligne).Value = Range("N" & Ligne) + N(i)
        End If
    Next i
Next Ligne
End Sub
Cliquez pour agrandir...


Bonjour sylvanu,
ta solution fonctionne parfaitement.
Merci pour tou.

Faroyo
 
Vote positif 0 Vote négatif
J

jmfmarques

XLDnaute Accro
Bien
Tu peux alors raccourcir mon code ainsi :
VB: 
derlig = Range("G" & Rows.Count).End(xlUp).Row
toto = Array("*ISO*", "*IBC*", "*SAC*", "*BAG*", "*ISOMIX*", "*GEL*", "*FUT*", "*POUDRE*", "*JERRYCAN*", "*JERRYCAN*", "*V5700*")
lesplus = Array(1000, 100)
For k = 4 To derlig
  PLUS = 0
  For n = 0 To UBound(toto)
    If UCase(Range("G" & k).Value) Like toto(n) Then MsgBox n: Exit For
  Next
  If n < 2 Then PLUS = lesplus(n)
  Range("O" & k).Value = Range("N" & k).Value + PLUS
Next
mais c'est juste pour t'exercer car cela n'est pas vraiment une amélioration.
 
Vote positif 0 Vote négatif
F

Faroyo

XLDnaute Junior
jmfmarques à dit:
Bien
Tu peux alors raccourcir mon code ainsi :
VB: 
derlig = Range("G" & Rows.Count).End(xlUp).Row
toto = Array("*ISO*", "*IBC*", "*SAC*", "*BAG*", "*ISOMIX*", "*GEL*", "*FUT*", "*POUDRE*", "*JERRYCAN*", "*JERRYCAN*", "*V5700*")
lesplus = Array(1000, 100)
For k = 4 To derlig
  PLUS = 0
  For n = 0 To UBound(toto)
    If UCase(Range("G" & k).Value) Like toto(n) Then MsgBox n: Exit For
  Next
  If n < 2 Then PLUS = lesplus(n)
  Range("O" & k).Value = Range("N" & k).Value + PLUS
Next
mais c'est juste pour t'exercer car cela n'est pas vraiment une amélioration.
Cliquez pour agrandir...


Désolé pour cette réponse aussi tardive.
C'est exactement ce qu'il me faut. Je débute en VBA et j'ai un grand besoin de voir ce type de variante pour bien comprendre la logique.
Encore merci pour vos réponses
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL 2016 Problème de conditions
Réponses
1
Affichages
836
nat54
nat54
P
  • Question
Microsoft 365 intégration code avec variable a un bouton de commande userform
Réponses
6
Affichages
778
PETIT YANNICK
P
P
  • Résolu(e)
XL 2016 Problème Macro
Réponses
12
Affichages
1 K
Pabloc
P
M
  • Question
XL 2016 If et else comment sortir de la boucle
Réponses
6
Affichages
2 K
migau
M
B
  • Question
boucle
Réponses
2
Affichages
758
BIL boud
B
GADENSEB
  • Question
Mise en majuscules / selection de colonnes
2
Réponses
19
Affichages
2 K
ralph45
ralph45
M
  • Question
charger de nombreux fichiers
Réponses
1
Affichages
711
ERIC S
ERIC S
patouman
  • Question
Probleme de macro complementaire a integrer dans macro existante
Réponses
6
Affichages
1 K
denis
D
A
  • Question
Erreur 91 Variable objet ou variable de bloc With non définie...
Réponses
3
Affichages
1 K
avekash
A
B
  • Question
Problèmes macro édition de courriers Excel-Word
2
Réponses
19
Affichages
2 K
Yaloo
Y

Membres actuellement en ligne

Aucun membre en ligne actuellement.
2 membres et 56 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa