Microsoft 365 LES EVENEMENTS

omario1995

XLDnaute Nouveau
Bonjour tout le monde,

S'il vous plaît, j'ai fait une macro,et du coup que cette macro s’exécute sans bouton ,je veux qu'elle s'exécute à chaque fois que je modifie dans une cellule dans une cellule de la colonne E de la feuille1.

le mode fonctionnent de cette macro est comme ça: si la valeur de la cellule dans la colonne E dans la feuille 1 est egal a la valeur de la cellule dans la colonne D dans la feuille 4 alors la case F prend la valeur de la case E dans la feuille 4.

feuille 1:
Capture.PNG


Voila la macro:

Sub Rame_loc()



Dim i As Integer
Dim j As Integer

For i = 62 To 92
For j = 3 To 25

If Feuil1.range("E" & i) = Feuil4.range("D" & j) Then

Feuil1.range("F" & i) = Feuil4.range("E" & j)




End If
Next
Next
End Sub



ET MERCI D’AVANCE
 
Solution
Bonjour,
Evidemment à l'aveugle, il y des chances que ça ne marche pas.
J'avais un doute, j'ai vérifié avec un fichier test, et effectivement ça ne marche pas.
Ci dessous une version qui au moins ne buggue pas :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin:
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 10 Then
        Traitement_Colonne_J (Target.Row)   ' Execution votre macro car colonne J
    ElseIf Target.Column = 5 Then
        Traitement_Colonne_E                ' Execution ma macro car colonne E
    End If
Fin:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Sub...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Omario,
Il faut utiliser la macro Worksheet_Change à placer obligatoirement dans la feuille concernée. Pour vous, à mettre dans Feuil1 :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub   ' Si plusieurs cellules sélectionnées, on sort
    If Not Intersect(Target, [E1:E65000]) Is Nothing Then ' Si dans la plage E1:E65000
         On Error GoTo Fin:
         Application.EnableEvents = False       ' On fige l'écran
         Application.ScreenUpdating = False     ' On interdit tout nouvel événement avant la fin de la macro
         ' ---------------------------------------------------------
         ' Macro à executer
        Dim i%, j%
        For i = 62 To 92
            For j = 3 To 25
                If Feuil1.Range("E" & i) = Feuil4.Range("D" & j) Then
                    Feuil1.Range("F" & i) = Feuil4.Range("E" & j)
                End If
            Next j
        Next i
        ' Fin macro spécifique
        ' ---------------------------------------------------------
    End If
Fin:
Application.ScreenUpdating = True   ' On remet les flags correctement.
Application.EnableEvents = True
End Sub
 

omario1995

XLDnaute Nouveau
Bonjour,

Merci beaucoup pour ta réponse qui fonctionne très bien ,j'ai un tout petit problème c'est que j'ai déjà un événement dans cette feuille,dans je suis obligé de changer le nom de ce dernier,ce qui l’empêche à fonctionner.

Private Sub Worksheet_Change(ByVal Target As range)
Application.ScreenUpdating = False

If Target.Column = 10 Then

Lignee = Target.Row

If range("I" & Lignee).Value <> "" Then


Dim i As Integer

If Lignee >= 10 Then
If range("I" & Lignee) = "Préventif" Then
On Error Resume Next
With range("K" & Lignee).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=indirect(J" & Lignee & ")"
'.IgnoreBlank = True
.InCellDropdown = True

End With

ElseIf range("I" & Lignee) <> "Préventif" Then
With range("K" & Lignee).Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
End If
End If

Else: Exit Sub
End If
Else: Exit Sub
End If
End Sub


Sub Worksheet_Change1(ByVal Target As range)


If Target.Count > 1 Then Exit Sub ' Si plusieurs cellules sélectionnées, on sort
If Not Intersect(Target, [E1:E65000]) Is Nothing Then ' Si dans la plage E1:E65000
On Error GoTo Fin:
Application.EnableEvents = False ' On fige l'écran
Application.ScreenUpdating = False ' On interdit tout nouvel événement avant la fin de la macro
' ---------------------------------------------------------
' Macro à executer
Dim i%, j%
For i = 62 To 92
For j = 3 To 25
If Feuil1.range("E" & i) = Feuil4.range("D" & j) Then
Feuil1.range("F" & i) = Feuil4.range("E" & j)
End If
Next j
Next i
' Fin macro spécifique
' ---------------------------------------------------------
End If
Fin:
Application.ScreenUpdating = True ' On remet les flags correctement.
Application.EnableEvents = True
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Effectivement il ne peut y avoir qu'une seule Worksheet_Change dans une feuille. Il faut donc les enchainer :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub   ' Si plusieurs cellules sélectionnées, on sort
    If Target.Column = 10 Then          ' Si colonne J
        ' Votre macro
    End If
    If Target.Column = 5 Then           ' Si colonne E
        ' Ma macro
    End If
End Sub
 

omario1995

XLDnaute Nouveau
j'ai essayé ça mais malheureusement aucune des macros n'as fonctionné:

Private Sub Worksheet_Change(ByVal Target As range)
Application.ScreenUpdating = False
Application.EnableEvents = False

If Target.Count > 1 Then Exit Sub

If Target.Column = 10 Then

Lignee = Target.Row

If range("I" & Lignee).Value <> "" Then


Dim i As Integer

If Lignee >= 10 Then
If range("I" & Lignee) = "Préventif" Then
On Error Resume Next
With range("K" & Lignee).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=indirect(J" & Lignee & ")"
'.IgnoreBlank = True
.InCellDropdown = True

End With

ElseIf range("I" & Lignee) <> "Préventif" Then
With range("K" & Lignee).Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
End If
End If

Else: Exit Sub
End If
Else: Exit Sub

Application.ScreenUpdating = True ' On remet les flags correctement.
Application.EnableEvents = True
End If


If Target.Column = 5 Then


If Not Intersect(Target, [E1:E65000]) Is Nothing Then ' Si dans la plage E1:E65000
On Error GoTo Fin:
Application.EnableEvents = False ' On fige l'écran
Application.ScreenUpdating = False ' On interdit tout nouvel événement avant la fin de la macro
' ---------------------------------------------------------
' Macro à executer
Dim j%
For i = 62 To 92
For j = 3 To 25
If Feuil1.range("E" & i) = Feuil4.range("D" & j) Then
Feuil1.range("F" & i) = Feuil4.range("E" & j)
End If
Next j
Next i
' Fin macro spécifique
' ---------------------------------------------------------
End If
Fin:
Application.ScreenUpdating = True ' On remet les flags correctement.
Application.EnableEvents = True






End If



End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Par pitié, utilisez les balises (</> à droite de l'icone GIF ) c'st mille fois plis lisible.
Et indentez votre code, là aussi, c'est plus lisible.
Il y a trois ligne de code bizarres :
VB:
Else: Exit Sub
End If
Else: Exit Sub
donc vous sortez de la macro, la suite ne sera pas exécutée.
Alors au pif, j'ai tenté :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 10 Then
        Lignee = Target.Row
        If Range("I" & Lignee).Value <> "" Then
            Dim i As Integer
            If Lignee >= 10 Then
                If Range("I" & Lignee) = "Préventif" Then
                    On Error Resume Next
                    With Range("K" & Lignee).Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                                    xlBetween, Formula1:="=indirect(J" & Lignee & ")"
                        '.IgnoreBlank = True
                        .InCellDropdown = True
                    End With
                ElseIf Range("I" & Lignee) <> "Préventif" Then
                    With Range("K" & Lignee).Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .ShowInput = True
                        .ShowError = True
                    End With
                End If
            End If
        End If
    End If
    If Target.Column = 5 Then
        On Error GoTo Fin:
        Application.EnableEvents = False ' On fige l'écran
        Application.ScreenUpdating = False ' On interdit tout nouvel événement avant la fin de la macro
        ' ---------------------------------------------------------
        ' Macro à executer
        Dim j%
        For i = 62 To 92
            For j = 3 To 25
                If Feuil1.Range("E" & i) = Feuil4.Range("D" & j) Then
                    Feuil1.Range("F" & i) = Feuil4.Range("E" & j)
                End If
            Next j
        Next i
        ' Fin macro spécifique
        ' ---------------------------------------------------------
    End If
Fin:
    Application.ScreenUpdating = True ' On remet les flags correctement.
    Application.EnableEvents = True
End Sub
Evidemment à l'aveugle, il y des chances que ça ne marche pas. Dans ce cas fournissez un fichier test pour pouvoir tester la macro. :)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Si vous avez peur de vous noyer dans le code, alors structurez le, ce sera beaucoup plus lisible :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin:
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 10 Then
        Traitement_Colonne_J (Target)   ' Execution votre macro car colonne J
    ElseIf Target.Column = 5 Then
        Traitement_Colonne_E (Target)   ' Execution ma macro car colonne E
    End If
Fin:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Sub Traitement_Colonne_J(Target)
        Lignee = Target.Row
        If Range("I" & Lignee).Value <> "" Then
            Dim i As Integer
            If Lignee >= 10 Then
                If Range("I" & Lignee) = "Préventif" Then
                    On Error Resume Next
                    With Range("K" & Lignee).Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                                    xlBetween, Formula1:="=indirect(J" & Lignee & ")"
                        '.IgnoreBlank = True
                        .InCellDropdown = True
                    End With
                ElseIf Range("I" & Lignee) <> "Préventif" Then
                    With Range("K" & Lignee).Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .ShowInput = True
                        .ShowError = True
                    End With
                End If
            End If
        End If
    End If
End Sub
Sub Traitement_Colonne_E(Target)
    Dim i%, j%
    For i = 62 To 92
        For j = 3 To 25
            If Feuil1.Range("E" & i) = Feuil4.Range("D" & j) Then
                Feuil1.Range("F" & i) = Feuil4.Range("E" & j)
            End If
        Next j
    Next i
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Evidemment à l'aveugle, il y des chances que ça ne marche pas.
J'avais un doute, j'ai vérifié avec un fichier test, et effectivement ça ne marche pas.
Ci dessous une version qui au moins ne buggue pas :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin:
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 10 Then
        Traitement_Colonne_J (Target.Row)   ' Execution votre macro car colonne J
    ElseIf Target.Column = 5 Then
        Traitement_Colonne_E                ' Execution ma macro car colonne E
    End If
Fin:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Sub Traitement_Colonne_J(Lignee)            ' Lignee est le N° de ligne de la cellule remplie
        If Range("I" & Lignee).Value <> "" Then
            Dim i As Integer
            If Lignee >= 10 Then
                If Range("I" & Lignee) = "Préventif" Then
                    On Error Resume Next
                    With Range("K" & Lignee).Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                                    xlBetween, Formula1:="=indirect(J" & Lignee & ")"
                        .InCellDropdown = True
                    End With
                ElseIf Range("I" & Lignee) <> "Préventif" Then
                    With Range("K" & Lignee).Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .ShowInput = True
                        .ShowError = True
                    End With
                End If
            End If
        End If
End Sub
Sub Traitement_Colonne_E()
    Dim i%, j%
    For i = 62 To 92
        For j = 3 To 25
            If Feuil1.Range("E" & i) = Feuil4.Range("D" & j) Then
                Feuil1.Range("F" & i) = Feuil4.Range("E" & j)
            End If
        Next j
    Next i
End Sub
 

Discussions similaires

Réponses
12
Affichages
537
Réponses
6
Affichages
202

Statistiques des forums

Discussions
311 724
Messages
2 081 938
Membres
101 844
dernier inscrit
pktla