Simplification de macro pour boucler sur tout un tableau [Résolu]

Messages postés
18
Date d'inscription
jeudi 21 mars 2019
Statut
Membre
Dernière intervention
22 octobre 2019
-
Bonjour à toutes et tous,
Me voila (re)perdu
J’ai modifié une petite macro qui me permet de changer des abondances en cote d’abondance en fonction de ce qui est inscrit dans la premier colonne. Dont voici le code
Sub categorie1()

Dim valCel As Variant
Dim rng As Range
Dim C As Range

Set rng = Range("B1:P1")
For Each C In rng
 valCel = C.Value
 If IsNumeric(valCel) Then
  Select Case valCel
     Case 0# To 0
    C.Value = "0"
    Case 1 To 2
    C.Value = "1"
    Case 3 To 4
    C.Value = "2"
    Case 5 To 8
    C.Value = "3"
    Case 9 To 10000000
    C.Value = "4"
    Case Else
    C.Interior.ColorIndex = 3
        
  End Select
 
 End If

Next

End Sub

Sub categorie2()

Dim valCel As Variant
Dim rng As Range
Dim C As Range

'pour faire les chlorures
Set rng = Range("B1:P1")

'on boucle sur chaque cellule de la plage
For Each C In rng
 valCel = C.Value
  
 'on teste si la valeur est un nombre
 If IsNumeric(valCel) Then
  Select Case valCel
     Case 0# To 0
    C.Value = "0"
    Case 1 To 2
    C.Value = "1"
    Case 3 To 16
    C.Value = "2"
    Case 17 To 64
    C.Value = "3"
    Case 65 To 10000000
    C.Value = "4"
    Case Else
    C.Interior.ColorIndex = 3
        
  End Select
 
 End If

Next

End Sub

Sub categorie3()

Dim valCel As Variant
Dim rng As Range
Dim C As Range

Set rng = Range("B1:P1")
For Each C In rng
 valCel = C.Value

 If IsNumeric(valCel) Then
  Select Case valCel
     Case 0# To 0
    C.Value = "0"
    Case 1 To 9
    C.Value = "1"
    Case 10 To 64
    C.Value = "2"
    Case 65 To 512
    C.Value = "3"
    Case 513 To 10000000
    C.Value = "4"
    Case Else
    C.Interior.ColorIndex = 3
        
  End Select
 
 End If

Next

End Sub

Sub Appelcateg()
    If Range("A1") = "Pommes" Then
        Call categorie1
    ElseIf Range("A1") = "Bananes" Then
        Call categorie2
    ElseIf Range("A1") = "Kiwis" Then
    Call categorie3
End If
End Sub




La macro fonctionne bien pour une ligne donnée mais dès que je souhaite la faire pour une autre ligne je n'ai pas trouvé d'autre façon que d'en faire une (une macro) pour toutes mes lignes. En gros, voici ce que j'avais en tête :

1- on teste la valeur de la première colonne première ligne
2- on applique le sub associé sur l'ensemble de la ligne (Ici je n'ai pas trouvé d'autre alternative que de la finir dans une cellule précise "P1", a terme j'aimerai finir mon sub a la fin de la ligne)
3-4 on recommence mais sur la ligne d'en bas

Je suis bloqué entre l'étape 2 et 4 en somme. SI une personne aurait le temps de se pencher sur mon léger problème.
D'avance merci
Afficher la suite 

3 réponses

Meilleure réponse
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46
1
Merci
Bonjour,
ci dessous une façon de faire qui tourne sur tout ton tableau quelle que soit le nombre de ligne et la nombre de colonnes:
Function AppelCateg(Lig As Integer)
    
    Select Case UCase(Worksheets("test").Range("A" & Lig).Value)
        Case "POMMES"
            AppelCateg = "categorie1"
        Case "BANANES"
            AppelCateg = "categorie2"
        '... je te laise écrire le reste
        Case Else
    End Select

End Function

Sub categorie()
    Dim i As Integer, derCol As Integer, derLig As Integer, j As Integer, tmpVal As Long
    Dim varCateg As String
    
    derCol = Worksheets("test").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    derLig = Worksheets("test").Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To derLig
        varCateg = AppelCateg(i)
        If varCateg = "categorie1" Then
            For j = 2 To derCol
                tmpVal = Worksheets("test").Cells(i, j).Value
                Select Case tmpVal
                    Case 0# To 0
                    tmpVal = "0"
                    Case 1 To 2
                    tmpVal = "1"
                    Case 3 To 4
                    tmpVal = "2"
                    Case 5 To 8
                    tmpVal = "3"
                    Case 9 To 10000000
                    tmpVal = "4"
                    Case Else
                    Worksheets("test").Cells(i, j).Interior.ColorIndex = 3
                End Select
                Worksheets("test").Cells(i, j).Value = tmpVal
            Next j
        End If
        If varCateg = "categorie2" Then
            For j = 2 To derCol
                tmpVal = Worksheets("test").Cells(i, j).Value
                Select Case tmpVal
                    Case 0# To 0
                    tmpVal = "0"
                    Case 1 To 2
                    tmpVal = "1"
                    Case 3 To 16
                    tmpVal = "2"
                    Case 17 To 64
                    tmpVal = "3"
                    Case 65 To 10000000
                    tmpVal = "4"
                    Case Else
                    Worksheets("test").Cells(i, j).Interior.ColorIndex = 3
                End Select
                Worksheets("test").Cells(i, j).Value = tmpVal
            Next j
        End If
        '...etc
    Next i
End Sub


Dire « Merci » 1

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 65168 internautes nous ont dit merci ce mois-ci

Moldude
Messages postés
18
Date d'inscription
jeudi 21 mars 2019
Statut
Membre
Dernière intervention
22 octobre 2019
-
Super ! Ça marche du feu de Dieu, merci beaucoup
Commenter la réponse de fabien25000
Messages postés
1184
Date d'inscription
lundi 23 juillet 2012
Statut
Membre
Dernière intervention
28 mai 2019
112
0
Merci
Bonjour Moldude,

Pour simplifier ton exercice, la première chose à faire est de créer une nouvelle feuille que tu nommes "PARAM" et qui comporte un Tableau1 de catégorie avec l'indice min des bornes :

Catégorie 1 2 3 4
Pommes 1 2 4 8
Bananes 1 2 16 64
Kiwis 1 9 64 512

Ensuite, il faudrait généraliser l'appel de Appelcateg, je ne sais pas comment tu le déclenches ?
tuxboy
Messages postés
1184
Date d'inscription
lundi 23 juillet 2012
Statut
Membre
Dernière intervention
28 mai 2019
112 -
Avec :
Public Function categ(a As String, x As Integer)
Application.Volatile
Ligne = Application.VLookup(a, [Tableau1], x + 1, False)
categ = Ligne
End Function


categ("Kiwis";3) retourne 64...
fabien25000
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46 -
Bonjour tuxboy,
si je ne me trompe pas c'est l'inverse qui est attendu, x doit être la valeur d'origine de la cellule et être remplacée par la valeur de la "tranche" donc x va de 10 à 64 et categ retourne 2 ?
Moldude
Messages postés
18
Date d'inscription
jeudi 21 mars 2019
Statut
Membre
Dernière intervention
22 octobre 2019
-
Bonjour et merci d'avoir pris le temps de se pencher sur le problème en effet.
En effet c'est l'inverse que je souhaite faire. je n'ai je pense pas été clair a 100%.
@fabien25000 exactement ! Si j'ai un nombre de "pommes" compris entre 5 et 8 une fois la macro lancée ceci correspond à une classe "3" d'abondance comme spécifié par la macro et donc dans ma case, à cet emplacement je dois retrouvé un "3"
Commenter la réponse de tuxboy
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46
0
Merci
Bonjour,

une piste à creuser.. si j'ai bien compris, je te laisse le soin de faire les boucles pour terminer

Function AppelCateg(Lig As Integer)
    
    Select Case UCase(Worksheets("nomdetafeuille").Range("A" & Lig).Value)
        Case "POMMES"
            AppelCateg = "categorie1"
        Case "BANANES"
            AppelCateg = "categorie2"
        '... je te laise écrire le reste
        Case Else
    End Select

End Function

Sub categorie()
    Dim i As Integer
    Dim derCol As Integer
    Dim vartab(derCol)
    Dim derLig As Integer
    Dim varCateg As String
    
    derCol = Worksheets("nomdetafeuille").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    derLig = Worksheets("nomdetafeuille").Range("A" & Rows.Count).End(xlUp).Row
    i=2 'si j'ai bien compris tu devrais débuter la boucle ici
    varCateg = AppelCateg(i)
    If varCateg = "categorie1" Then
        vartab(1) = 1
        vartab(2) = 2
        vartab(3) = 3
        vartab(4) = 4
    End If
    If varCateg = "categorie2" Then
        vartab(1) = 1
        vartab(2) = 3
        vartab(3) = 17
        vartab(4) = 65
    End If
    '...etc
    
End Sub

Moldude
Messages postés
18
Date d'inscription
jeudi 21 mars 2019
Statut
Membre
Dernière intervention
22 octobre 2019
-
Bonjour,
et Merci pour la macro.
Je comprend un peu le principe malgré mes faibles connaissance du vba, par contre quand je tente de lancer la macro pour la tester j'ai une erreur de compilation "constante requise" malgré différentes combinaisons testée. Où fait-je capoté la macro? "nomdetafeuille" qui n'est pas bon peut-être?
fabien25000
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46 -
poste ton fichier via mon partage je jetterai un oeil dans la journée si tu veux
Commenter la réponse de fabien25000