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

Question

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

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

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

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

tuxboy · Answer

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 ?

fabien25000 · Answer

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

fabien25000 · Answer

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

Simplification de macro pour boucler sur tout un tableau

3 réponses

Votre réponse

Discussions similaires

Newsletters