Comment réduir une macro avec 5 X 30 conditions?

Bonjour a tous

Je ne suis pas expert mais je me suis lance dans qq chose de monstrueux

Comment réduit une macro de 5 conditions qui ont chacune 30 autres?

Un gros merci

Voici mon code:

Function SeparationParPalette_05()
Dim Lettrage As String, Palette As Integer, Temp As Integer, McxLousse As Integer, NoBassin As Integer

NoBassin = Range("'1=ISO'!BO9") + 1

If Range("'1=ISO'!AI104") >= 1 Then
    While Range("'1=ISO'!AI3") > Range("'1=ISO'!CV39")
        'Range("'1=ISO'!BO11") = Range("'1=ISO'!BO11") + 1 'Le numéro est augmenté de 1 à chaque boucle
            Range("'1=ISO'!AI3") = Range("'1=ISO'!AI3") - Range("'1=ISO'!CV39")
                If Range("'1=ISO'!BO9") = 1 Then
                    Range("RapportParBassin!B400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!C400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 2 Then
                    Range("RapportParBassin!D400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!E400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 3 Then
                    Range("RapportParBassin!F400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!G400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 4 Then
                    Range("RapportParBassin!H400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!I400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 5 Then
                    Range("RapportParBassin!J400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!K400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 6 Then
                    Range("RapportParBassin!L400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!M400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 7 Then
                    Range("RapportParBassin!N400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!O400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 8 Then
                    Range("RapportParBassin!P400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!Q400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 9 Then
                    Range("RapportParBassin!R400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!S400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 10 Then
                    Range("RapportParBassin!T400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!U400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 11 Then
                    Range("RapportParBassin!V400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!W400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 12 Then
                    Range("RapportParBassin!X400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!Y400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 13 Then
                    Range("RapportParBassin!Z400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AA400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 14 Then
                    Range("RapportParBassin!AB400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AC400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 15 Then
                    Range("RapportParBassin!AD400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AE400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 16 Then
                    Range("RapportParBassin!AF400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AG400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 17 Then
                    Range("RapportParBassin!AH400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AI400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 18 Then
                    Range("RapportParBassin!AJ400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AK400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 19 Then
                    Range("RapportParBassin!AL400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AM400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 20 Then
                    Range("RapportParBassin!AN400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AO400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 21 Then
                    Range("RapportParBassin!AP400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AQ400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 22 Then
                    Range("RapportParBassin!AR400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AS400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 23 Then
                    Range("RapportParBassin!AT400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AU400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 24 Then
                    Range("RapportParBassin!AV400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AW400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 25 Then
                    Range("RapportParBassin!AX400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!AY400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 26 Then
                    Range("RapportParBassin!AZ400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!BA400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 27 Then
                    Range("RapportParBassin!BB400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!BC00").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 28 Then
                    Range("RapportParBassin!BD400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!BE400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 29 Then
                    Range("RapportParBassin!BF400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!BG400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                ElseIf Range("'1=ISO'!BO9") = 30 Then
                    Range("RapportParBassin!BH400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = Range("'1=ISO'!CV39")
                    Range("RapportParBassin!BI400").End(xlUp).Offset(1, 0).Select
                    ActiveCell = "1A"
                End If
    Wend
    While Range("'1=ISO'!AI4") > Range("'1=ISO'!CV40")
            ' REMPLACER PAR LES 30 CONDITIONS
            Range("'1=ISO'!AI4") = Range("'1=ISO'!AI4") - Range("'1=ISO'!CV40")
            Range("RapportParBassin!B400").End(xlUp).Offset(1, 0).Select
            ActiveCell = Range("'1=ISO'!CV40")
            Range("RapportParBassin!C400").End(xlUp).Offset(1, 0).Select
            ActiveCell = "1B"
    Wend
    While Range("'1=ISO'!AI5") > Range("'1=ISO'!CV41")
            ' REMPLACER PAR LES 30 CONDITIONS
            Range("'1=ISO'!AI5") = Range("'1=ISO'!AI5") - Range("'1=ISO'!CV41")
            Range("RapportParBassin!B400").End(xlUp).Offset(1, 0).Select
            ActiveCell = Range("'1=ISO'!CV41")
            Range("RapportParBassin!C400").End(xlUp).Offset(1, 0).Select
            ActiveCell = "1"
    Wend
    While Range("'1=ISO'!AI6") > Range("'1=ISO'!CV42")
            ' REMPLACER PAR LES 30 CONDITIONS
            Range("'1=ISO'!AI6") = Range("'1=ISO'!AI6") - Range("'1=ISO'!CV42")
            Range("RapportParBassin!B400").End(xlUp).Offset(1, 0).Select
            ActiveCell = Range("'1=ISO'!CV42")
            Range("RapportParBassin!C400").End(xlUp).Offset(1, 0).Select
            ActiveCell = "2"
    Wend
    While Range("'1=ISO'!AI7") > Range("'1=ISO'!CV43")
            ' REMPLACER PAR LES 30 CONDITIONS
            Range("'1=ISO'!AI7") = Range("'1=ISO'!AI7") - Range("'1=ISO'!CV43")
            Range("RapportParBassin!B400").End(xlUp).Offset(1, 0).Select
            ActiveCell = Range("'1=ISO'!CV43")
            Range("RapportParBassin!C400").End(xlUp).Offset(1, 0).Select
            ActiveCell = "3"
    Wend
    While Range("'1=ISO'!AI8") > Range("'1=ISO'!CV44")
            ' REMPLACER PAR LES 30 CONDITIONS
            Range("'1=ISO'!AI8") = Range("'1=ISO'!AI8") - Range("'1=ISO'!CV44")
            Range("RapportParBassin!B400").End(xlUp).Offset(1, 0).Select
            ActiveCell = Range("'1=ISO'!CV44")
            Range("RapportParBassin!C400").End(xlUp).Offset(1, 0).Select
            ActiveCell = "4"
    Wend
End If
End Function

L'instruction CASE serait plus lisible ... mais cela ne va pas réduire le nombre de lignes.

Une autre solution est de changer de stratégie et faire appel à un tableau + une fonction de type RECHERCHEV ou DECALER afin de ne pas avoir à tester tous les cas car si je comprends bien les valeurs testées décalent le résultat dans une colonne adjacente. Pour tester il faudrait un bout de fichier. Cela permettrait de voir aussi si on peut "mutualiser" les xlup bien qu'ils fassent appel à des colonnes différentes !

Bonsoir,

une proposition, sans avoir eu la possibilité de tester

Function SeparationParPalette_05V1()
    Dim Lettrage As String, Palette As Integer, Temp As Integer, McxLousse As Integer, NoBassin As Integer, B As Integer, C As Integer
    Dim r As Variant
    r = Array("1A", "1B", 1, 2, 3, 4)
    ReDim Preserve r(3 To 8)

    NoBassin = Range("'1=ISO'!BO9") + 1

    If Range("'1=ISO'!AI104") >= 1 Then
        For i = 3 To 8 '(de AI3 à AI8 et CV39 à CV44)
              While Range("'1=ISO'!AI" & i) > Range("'1=ISO'!CV" & 36 + i)
                Range("'1=ISO'!AI" & i) = Range("'1=ISO'!AI" & i) - Range("'1=ISO'!CV" & 36 + i)
                With Sheets("RapportParBassin")
                    B = (Sheets("1=ISO").Range("BO9") - 1) * 2 + 1
                    C = B + 1
                    .Cells(400, B).End(xlUp).Offset(1, 0) = Range("'1=ISO'!CV" & 36 + i)
                    .Cells(400, C).End(xlUp).Offset(1, 0) = r(i)
                End With
            Wend
        Next i
    End If
End Function