Simplification de macro pour boucler sur tout un tableau

Résolu
Moldude Messages postés 19 Statut Membre -  
Moldude Messages postés 19 Statut Membre -
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

3 réponses

  1.
    fabien25000 Messages postés 697 Statut Membre 59
     
    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
    1. Moldude Messages postés 19 Statut Membre
       
      Super ! Ça marche du feu de Dieu, merci beaucoup
      0
  2. tuxboy Messages postés 1083 Statut Membre 190
     
    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
    1. tuxboy Messages postés 1083 Statut Membre 190
       
      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
    2. fabien25000 Messages postés 697 Statut Membre 59
       
      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
    3. Moldude Messages postés 19 Statut Membre
       
      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
  3. fabien25000 Messages postés 697 Statut Membre 59
     
    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
    1. Moldude Messages postés 19 Statut Membre
       
      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
    2. fabien25000 Messages postés 697 Statut Membre 59
       
      poste ton fichier via mon partage je jetterai un oeil dans la journée si tu veux
      0

Discussions similaires

exo pix
Xtyller -
Raymond PENTIER -

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

13 réponses
garder constant des calculs
jack2125 -
PHILOU10120 -

4 réponses