Microsoft 365 LES EVENEMENTS

O

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
sylvanu
Bonjour,
sylvanu à dit:
Evidemment à l'aveugle, il y des chances que ça ne marche pas.
Cliquez pour agrandir...
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...
Trier par date Trier par votes
sylvanu

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
docs.microsoft.com

Événement Worksheet.Change (Excel)

Rubrique de référence sur Office VBA
docs.microsoft.com
 
Vote positif 0 Vote négatif
O

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
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif
O

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
 
Vote positif 0 Vote négatif
sylvanu

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. :)
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
sylvanu à dit:
Evidemment à l'aveugle, il y des chances que ça ne marche pas.
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Solution

Discussions similaires

M
  • Question
XL 2010 Remise et ajout de quantité
Réponses
10
Affichages
627
Dranreb
Dranreb
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
488
Compte Supprimé 979
C
D
  • Question
XL 2016 Exporter au format PDF dans un dossier existant les colonnes ciblées et en filtrant les lignes qui contiennent une valeur quelconque.
Réponses
6
Affichages
619
Phil69970
Phil69970
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
420
GClaire
G
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
473
AtTheOne
AtTheOne
Regueiro
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
630
sylvanu
sylvanu
A
  • Résolu(e)
Microsoft 365 Vider des listes déroulantes en cascade
Réponses
6
Affichages
532
Franc58
F
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
586
halecs93
halecs93
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
374
Le Rouky
L
S
  • Question
XL 2019 Remplir une combobox avec une ligne
2
Réponses
17
Affichages
962
fanch55
fanch55

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 59 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA