Problème macro avec VBA
Manu40300
-
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Problème macro avec VBA
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Excel compter cellule couleur sans vba - Guide
- Arreter une macro vba ✓ - Forum VB / VBA
1 réponse
Bonjour,
Ce sont vos range(xxx).select qui sement la pagaille
Application.EnableEvents corrige, mais attention si plantage macro
Bonne suite
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
