Problème macro avec VBA

Question

Bonjour à tous,

Je suis en train de faire une macro et je n'ai plus qu'une chose à modifier mais étant totalement novice, j'aurai besoin d'aide. Le problème à rectifier est la partie en gras, le reste de la macro fonctionne correctement et permet simplement de masquer diverses lignes de la feuille suivant les valeurs de certaines cellule.

Concernant la partie en gras, Je ne sais pas si j'ai utilisé les bonnes fonctions alors voici ce que je veux que ma macro fasse exactement:
Si en cellule B18, je rentre 1
Je me retrouve en H18, jusque la ça va.
Par la suite, je voudrais  qu'une fois que j'ai rentré la valeur en cellule H18, le programme vérifie que la valeur sur la colonne B pour chacune des lignes 31 à 35 est égale à la valeur de la cellule H18 multiplié par 2. Ainsi les lignes ne respectant pas la condition se masquent.

Merci pour votre aide.

Option Explicit


Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Union(Range("B10"), Range("B14"), Range("B18"), Range("B20"))) Is Nothing Then ' Condition pour que cela ne se déclenche pas si changement autre cellule
    Select Case Target.Address
        Case Is = Range("B10").Address
            Select Case Target.Value
                Case "1"
                    Rows("36:37").EntireRow.Hidden = True
                    Range("H10").Select
                Case "2"
                    Rows("36:37").EntireRow.Hidden = False
                    Range("B12").Select
            End Select
        Case Is = Range("B14").Address
            Select Case Target.Value
                Case "1"
                    Rows("38:38").EntireRow.Hidden = True
                    Range("B15").Select
                Case "2"
                    Rows("38:38").EntireRow.Hidden = False
                    Range("B15").Select
            End Select
        Case Is = Range("B18").Address
            Select Case Target.Value
                Case "1"
                Range("H18").Select
                Dim ligne As Integer
                    For ligne = 31 To 35
                    If Cells(ligne, 2) <> Cells(18, 8).Value * 0.2 Then
                    Rows(ligne & ":" & ligne).EntireRow.Hidden = True
                    Range("B20").Select
                    End If
                    Next
                Case "2"
                    Range("31:35").EntireRow.Hidden = False
                    Range("B20").Select
            End Select
         Case Is = Range("B20").Address
            Select Case Target.Value
                Case "1"
                    Rows("30:30").EntireRow.Hidden = True
                    Range("H20").Select
                Case "2"
                    Rows("30:30").EntireRow.Hidden = False
                    Range("B22").Select
            End Select
    End Select
End If
End Sub

Manu

f894009 · Answer

Bonjour,

Ce sont vos range(xxx).select qui sement la pagaille

Application.EnableEvents corrige, mais attention si plantage macro

Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Union(Range("B10"), Range("B14"), Range("B18"), Range("B20"))) Is Nothing Then ' Condition pour que cela ne se déclenche pas si changement autre cellule
        
        'stop les evenements de la feuille (voir aide excel)
        Application.EnableEvents = False

    Select Case Target.Address
        Case Is = Range("B10").Address
        Select Case Target.Value
            Case "1"
                Rows("36:37").EntireRow.Hidden = True
                Range("H10").Select
            Case "2"
                Rows("36:37").EntireRow.Hidden = False
                Range("B12").Select
        End Select
        Case Is = Range("B14").Address
        Select Case Target.Value
            Case "1"
                Rows("38:38").EntireRow.Hidden = True
                Range("B15").Select
            Case "2"
                Rows("38:38").EntireRow.Hidden = False
                Range("B15").Select
        End Select
        Case Is = Range("B18").Address
        Select Case Target.Value
            Case "1"
                Range("H18").Select
                Dim ligne As Integer
                For ligne = 31 To 35
                    If Cells(ligne, 2) <> Cells(18, 8).Value * 0.2 Then
                        Rows(ligne & ":" & ligne).EntireRow.Hidden = True
                    End If
                Next ligne
                Range("B20").Select
            Case "2"
                Range("31:35").EntireRow.Hidden = False
                Range("B20").Select
        End Select
        Case Is = Range("B20").Address
        Select Case Target.Value
            Case "1"
                Rows("30:30").EntireRow.Hidden = True
                Range("H20").Select
            Case "2"
                Rows("30:30").EntireRow.Hidden = False
                Range("B22").Select
        End Select
    End Select
End If

Application.EnableEvents = True

End Sub

'tres utile si plantage
Sub relance_events()
    Application.EnableEvents = True
End Sub

Bonne suite

Problème macro avec VBA

1 réponse

Discussions similaires

Newsletters