Fusionner deux macros worksheet_change

[Jec]

Bonjour,

Quelqu'un aurait une idee comment fusionner deux macros worksheet_change car separement sur une meme feuille cela ne marche pas et me renvoi un message d erreur. Si quelqu un aurait la solution je suis preneur.

Merci a tous.

Private Sub Worksheet_Change(ByVal Target As Range)

k = 0
For i = 208 To 300
    For j = 25 To 300
        If Application.WorksheetFunction.CountBlank(Cells(i, j)) = 0 Then
           
            If Cells(i, j) <> Cells(i, j - 1) Then
                k = k + 1
            End If
           
            If 2 + k > 56 Then
                k = 1
            ElseIf (2 + k = 11) Or (2 + k = 25) Then
                k = k + 1
            End If
           
            Cells(i, j).Interior.ColorIndex = 2 + k
           
        Else
            Cells(i, j).Interior.ColorIndex = 2
        End If
    Next j
Next i

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, [M6:M205]) Is Nothing Then
        Call macro_tri
End If


Sub macro_tri()
    ActiveWorkbook.Worksheets("prod").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("prod").Sort.SortFields.Add Key:=Range("G6:G205"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("prod").Sort.SortFields.Add Key:=Range("M6:M205"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("prod").Sort
        .SetRange Range("B5:V205")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
  End Sub

 

[JCGL]

Bonjour à tous,

Peux-tu essayer avec :

Private Sub Worksheet_Change(ByVal Target As Range)
    k = 0
    For i = 208 To 300
        For j = 25 To 300
            If Application.WorksheetFunction.CountBlank(Cells(i, j)) = 0 Then
                If Cells(i, j) <> Cells(i, j - 1) Then
                    k = k + 1
                End If
                If 2 + k > 56 Then
                    k = 1
                ElseIf (2 + k = 11) Or (2 + k = 25) Then
                    k = k + 1
                End If
                Cells(i, j).Interior.ColorIndex = 2 + k
            Else
                Cells(i, j).Interior.ColorIndex = 2
            End If
        Next j
    Next i
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, [M6:M205]) Is Nothing Then
        Call macro_tri
    End If
End Sub

Sub macro_tri()
    ActiveWorkbook.Worksheets("Prod").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Prod").Sort.SortFields.Add Key:=Range("G6:G205"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Prod").Sort.SortFields.Add Key:=Range("M6:M205"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Prod").Sort
        .SetRange Range("B5:V205")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

A+ à tous

 

[mapomme]

Bonjour jec,

Une proposition:

Changer les déclarations des procédures évènementielles pouir en faires des procédures normales. Ecrire une nouvelle procédure évènementielle qui appelle les précédentes. Ca ne marche sans doute pas à tous les coup en fonction de ce font chaque procédure change1 et change2.

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   change1 Target
   change2 Target
   Application.EnableEvents = True
End Sub

'ex première Private Sub Worksheet_Change(ByVal Target As Range)
Sub change1(Target)
   ...
   ...
End Sub

'ex deuxième Private Sub Worksheet_Change(ByVal Target As Range)
Sub change2(Target)
   ...
   ... 
End Sub

edit: Bonjour JCGL

 

[Jec]

Bonjour,

Merci pour votre proposition cela fonctionne cependant je me suis rendu compte que ma seconde macro ne fonctionne pas comme je le voudrais en effet, elle se dechenche que lorsqu il y a un changement de donnees manuel. Cependant je voudrais que des lorsque une des donnees de la collone change la macro se lance meme si ce n est pas manuel mais du a un calcul automatique. Target, [M6:M205])

If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, [M6:M205]) Is Nothing Then
Call macro_tri
End If

 

[JCGL]

Bonjour à tous,
Salut MaPomme,

Mets cette ligne en deuxième ligne:

 If Not Application.Intersect(Target, [M6:M205]) Is Nothing Then

A+ à tous

 

[Jec]

Comment ça ?
Le problème avec ce code c'est que j'ai l'impression qu'elle ne prend en compte que si la valeur est modifié manuellement mais pas si elle est le résultat d'une formule. Par exemple la colonne g fait référence (formule) à la colonne A. donc si je change une valeur dans la colonne A du coup la valeur dans la colonne G va changer et la alors dois intervenir la macro. Ma question est de savoir si ce code prend en compte ce changement.

 

[JCGL]

Bonjour à tous,

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, [M6:M205]) Is Nothing Then
    k = 0
    For i = 208 To 300
        For j = 25 To 300
            If Application.WorksheetFunction.CountBlank(Cells(i, j)) = 0 Then
                If Cells(i, j) <> Cells(i, j - 1) Then
                    k = k + 1
                End If
                If 2 + k > 56 Then
                    k = 1
                ElseIf (2 + k = 11) Or (2 + k = 25) Then
                    k = k + 1
                End If
                Cells(i, j).Interior.ColorIndex = 2 + k
            Else
                Cells(i, j).Interior.ColorIndex = 2
            End If
        Next j
    Next i
    If Target.Count > 1 Then Exit Sub
        Call macro_tri
    End If
End Sub

Sub macro_tri()
    ActiveWorkbook.Worksheets("Prod").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Prod").Sort.SortFields.Add Key:=Range("G6:G205"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Prod").Sort.SortFields.Add Key:=Range("M6:M205"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Prod").Sort
        .SetRange Range("B5:V205")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

A+ à tous

 

[Dranreb]

Ma question est de savoir si ce code prend en compte ce changement.

Non, dans la mesure où Target ne comportera que les cellules dont le contenu a changé, et non dont la valeur due à une formule a changé.