Aide sur une macro excel

Fermé
cédric - 13 sept. 2012 à 21:54
 cedric - 14 sept. 2012 à 12:07
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.



A voir également:

3 réponses

Mytå Messages postés 2973 Date d'inscription mardi 20 janvier 2009 Statut Contributeur Dernière intervention 20 décembre 2016 950
Modifié par Mytå le 14/09/2012 à 00:33
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
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
Mytå Messages postés 2973 Date d'inscription mardi 20 janvier 2009 Statut Contributeur Dernière intervention 20 décembre 2016 950
14 sept. 2012 à 08:09
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
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