Sujet Précédent Sujet Suivant

Simplification de macro pour boucler sur tout un tableau

Résolu/Fermé
Moldude Messages postés 19 Date d'inscription jeudi 21 mars 2019 Statut Membre Dernière intervention 8 janvier 2020 - Modifié le 28 mai 2019 à 13:32
Moldude Messages postés 19 Date d'inscription jeudi 21 mars 2019 Statut Membre Dernière intervention 8 janvier 2020 - 4 juin 2019 à 08:08
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
A voir également:

3 réponses

Réponse 1 / 3
fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
31 mai 2019 à 09:31
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
1
Moldude Messages postés 19 Date d'inscription jeudi 21 mars 2019 Statut Membre Dernière intervention 8 janvier 2020
4 juin 2019 à 08:08
Super ! Ça marche du feu de Dieu, merci beaucoup
0
Réponse 2 / 3
tuxboy Messages postés 995 Date d'inscription lundi 23 juillet 2012 Statut Membre Dernière intervention 28 mai 2019 190
28 mai 2019 à 14:20
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 ?
0
tuxboy Messages postés 995 Date d'inscription lundi 23 juillet 2012 Statut Membre Dernière intervention 28 mai 2019 190
28 mai 2019 à 16:04
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...
0
fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
28 mai 2019 à 16:20
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 ?
0
Moldude Messages postés 19 Date d'inscription jeudi 21 mars 2019 Statut Membre Dernière intervention 8 janvier 2020
29 mai 2019 à 08:38
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"
0
Réponse 3 / 3
fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
28 mai 2019 à 15:09
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

0
Moldude Messages postés 19 Date d'inscription jeudi 21 mars 2019 Statut Membre Dernière intervention 8 janvier 2020
29 mai 2019 à 08:43
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?
0
fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
29 mai 2019 à 10:14
poste ton fichier via mon partage je jetterai un oeil dans la journée si tu veux
0

Discussions similaires

Impossible d'afficher le rapport de tableau croisé dynamique sur un rapport
Utilisateur anonyme -
TomH. -

13 réponses
Bibliothèque
cosjac85 -
renard bleu -

3 réponses
exo pix
Xtyller -
Raymond PENTIER -

2 réponses
Tableau croisé dynamique - absence de certaines données
crazyrider71 -
Hana -

4 réponses