Microsoft 365 Creation de boucle

Faroyo · 3 Juin 2020

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.

sylvanu · 3 Juin 2020

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

_Thierry · 3 Juin 2020

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

jmfmarques · 3 Juin 2020

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

Faroyo · 3 Juin 2020

merci pour vos réponses.
Je vais tester tout cela de suite.

Faroyo · 3 Juin 2020

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

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

Faroyo · 3 Juin 2020

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

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

Faroyo

jmfmarques · 3 Juin 2020

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

K est à typer en Long

Faroyo · 3 Juin 2020

Merci pour tout.
C'est parfait.

jmfmarques · 3 Juin 2020

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.

Faroyo · 5 Juin 2020

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.

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

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Creation de boucle

Faroyo

XLDnaute Junior

jmfmarques

sylvanu

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

Faroyo

XLDnaute Junior

Faroyo

XLDnaute Junior

Faroyo

XLDnaute Junior

jmfmarques

XLDnaute Accro

Faroyo

XLDnaute Junior

jmfmarques

XLDnaute Accro

Faroyo

XLDnaute Junior

Discussions similaires

Nous accordons de l'importance à votre vie privée