Aide sur une macro excel

Bonjour à tous,

Je viens vers vous afin de solliciter l'aide de la communauté pour simplifier une macro VBA.

En gros j'ai un fichier, sur lequel les utilisateurs vont renseigner le nombre de colis reçus (entre 1 et 40)

en validant la saisis la macro va ouvrir les lignes correspondant laissant apparaître un tableau à remplir (4 lignes par colis reçu)

j'ai écris la macro suivante:

(en gros la macro cache l'intégralité du tableau puis démasque autant de tableau (de 4 lignes) qu'il y a de colis reçus.

Sub colis1()
Rows("79:238").Select
Selection.EntireRow.Hidden = True

If Range("h53") = 1 Then
Rows("79:82").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If
If Range("h53") = 2 Then
Rows("79:86").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 3 Then
Rows("79:90").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 4 Then
Rows("79:94").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 5 Then
Rows("79:98").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 6 Then
Rows("79:102").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 7 Then
Rows("79:106").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 8 Then
Rows("79:110").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 9 Then
Rows("79:114").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 10 Then
Rows("79:118").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 11 Then
Rows("79:122").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 12 Then
Rows("79:126").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 13 Then
Rows("79:130").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 14 Then
Rows("79:134").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 15 Then
Rows("79:138").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 16 Then
Rows("79:142").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 17 Then
Rows("79:146").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 18 Then
Rows("79:150").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 19 Then
Rows("79:154").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 20 Then
Rows("79:158").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 21 Then
Rows("79:162").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 22 Then
Rows("79:166").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 23 Then
Rows("79:170").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 24 Then
Rows("79:174").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 25 Then
Rows("79:178").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 26 Then
Rows("79:182").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 27 Then
Rows("79:186").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 28 Then
Rows("79:190").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 29 Then
Rows("79:194").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 30 Then
Rows("79:198").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 31 Then
Rows("79:202").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 32 Then
Rows("79:206").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 33 Then
Rows("79:210").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 34 Then
Rows("79:214").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 35 Then
Rows("79:218").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 36 Then
Rows("79:222").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 37 Then
Rows("79:226").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 38 Then
Rows("79:230").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 39 Then
Rows("79:234").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

If Range("h53") = 40 Then
Rows("79:238").Select
Selection.EntireRow.Hidden = False
Range("k53").Select
End If

End Sub

Y a t il une façon d'écrire la macro plus simple?

Merci beaucoup de votre aide.

3 réponses

  1. Bonjour à tous,

    Vraiment merci beaucoup pour ton retour.

    Alors voici la macro terminée (valable pour l'ensemble du fichier excel)

    elle ne fonctionne pas parfaitement, est elle trop grosse ou y a t il des lignes qui se contredisent?

    (lorsque je met 0 elle ne se ferme pas ou la macro ne répond pas)

    Merci vraiment ;D

    Sub ok()

    If Range("f51") <> "ERREUR" Then

    With Range("g58")
    Rows("399:562").EntireRow.Hidden = True
    If .Value < 1 Or .Value > 40 Then Exit Sub
    Rows("399:" & 402 + (.Value - 1) * 4).EntireRow.Hidden = False
    End With

    With Range("g57")

    Rows("239:398").EntireRow.Hidden = True
    If .Value < 1 Or .Value > 40 Then Exit Sub
    Rows("239:" & 242 + (.Value - 1) * 4).EntireRow.Hidden = False
    End With

    With Range("g59")

    Rows("563:722").EntireRow.Hidden = True
    If .Value < 1 Or .Value > 40 Then Exit Sub
    Rows("563:" & 566 + (.Value - 1) * 4).EntireRow.Hidden = False
    End With

    If Range("b52") = vrai Then
    Rows("75:78").EntireRow.Hidden = True
    ElseIf Range("b52") = faux Then
    Rows("75:78").EntireRow.Hidden = False
    End If

    If Range("b58") = "x" Then
    Rows("883:886").EntireRow.Hidden = True
    ElseIf Range("b58") = "xx" Then
    Rows("883:886").EntireRow.Hidden = False
    End If

    With Range("g62")
    Rows("887:1046").EntireRow.Hidden = True
    If .Value < 1 Or .Value > 40 Then Exit Sub
    Rows("887:" & 890 + (.Value - 1) * 4).EntireRow.Hidden = False
    End With

    With Range("g56")
    Rows("79:238").EntireRow.Hidden = True
    If .Value < 1 Or .Value > 40 Then Exit Sub
    Rows("79:" & 82 + (.Value - 1) * 4).EntireRow.Hidden = False
    End With

    With Range("g60")

    Rows("723:882").EntireRow.Hidden = True
    If .Value < 1 Or .Value > 40 Then Exit Sub
    Rows("723:" & 726 + (.Value - 1) * 4).EntireRow.Hidden = False
    End With

    End If

    Range("h55").Select

    End Sub
    0
    1. Merci Myta,

      La macro est super à la seul précison que si h53 = 0 toutes les lignes doivent être closes.

      Pourrais tu juste me préciser comment compiler cela?

      Merci beaucoup vraiment ;)
      0
      1. Contributeur
        Re le forum

        Il suffit d'inverser deux lignes
        Sub colis1()
            With Range("H53")
                Rows("79:238").EntireRow.Hidden = True
                If .Value < 1 Or .Value > 40 Then Exit Sub
                Rows("79:" & 82 + (.Value - 1) * 4).EntireRow.Hidden = False
                .Offset(0, 3).Select
            End With
        End Sub
        

        Mytå
        0
    2. Contributeur
      Salut le forum

      Essaye comme ceci
      Sub colis1() 
          With Range("H53") 
              If .Value < 1 Or .Value > 40 Then Exit Sub 
              Rows("79:238").EntireRow.Hidden = True 
              Rows("79:" & 82 + (.Value - 1) * 4).EntireRow.Hidden = False 
              .Offset(0, 3).Select 
          End With 
      End Sub 
      

      Mytå
      Quelle prétention de prétendre que l'informatique est récente
      Adam et Eve avaient déjà un Apple ! [MsProject 2003(FR), Excel 2003-2007(FR)]
      0