Intersect et variable

Version imprimable

Bonjour les Kracks,

La macro ci-dessous me permet à chaque changement de cellule de la colonne C (dans une feuille donnée "fonction Worksheet_Change"), d'aller vérifier dans une autre feuille si le chiffre inscrit s'y trouve également et si oui, d'appliquer une condition.
Cette application fonctionne mais j'ai remarqué que lorsque dans cette onglet je sélectionne une ligne complète et j'essaie de la supprimer, sa bug!:cry:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Chase a number with special conditions in other sheet
 
Dim Accrng As Range
 
 
If Not Intersect(Target, Columns(3)) Is Nothing Then
'si la cellule modifiée appartient à la colonne 3 (C), alors
    Set Accrng = Target
    'fixer la variable Accrng
  Accrng.Offset(0, 2).FormulaR1C1 = "=VLOOKUP(RC[-2],Specialfees!C[-4]:C[4],4,FALSE)'??????? check why when we selected all ligne is bug"
        'La formule de la colonne E devient : C6 modifiée =>
    'E6 : "=RECHERCHEV(C6;Specialfees!A:K;4;0)" => Valeur de D de la ligne contenant C6 en A
    If IsError(Accrng.Offset(0, 2)) Then    'Si on ne trouve pas de valeur, alors
        Accrng.Offset(0, 2).ClearContents   'On efface E6
        Accrng.Offset(0, 1).Select          'On selectionne E6, prochaine cellule à encoder pour l'utilisateur
    Else 'Sinon
        Accrng.Offset(0, 2).Copy            'on copie la valeur donnée par le vlookup
        Accrng.Offset(0, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
       'on colle uniquement la valeur afin qu'il n'y ai plus de trace du vlookup nous permettant ainsi de retrouver la valeur dans le fichier par une fonction recherche Ctrl*f
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Accrng.Offset(0, 1).Select
        'On selectionne D6, prochaine cellule à encoder pour l'utilisateur
   End If
 End If
End Sub

Le message d'erreur est le suivant:

Citation:

Msg d'erreur:

Accrng.Offset(0,2).FormulaR1C1=<Application-defined or object-defined error>

09/12/2010, 15h13
pgz

Bonjour.

Dans la procédure, en début, tu peux ajouter

Code:

If Target.Columns.Count>1 then exit sub

Cela devrait éviter d'exécuter la procédure en cas d'effacement d'une ligne.

Cordialement,

PGZ
09/12/2010, 15h46
Djromé

Salut Pgz,

Bon subterfuge, celà fonctionne très bien!

Merci

Tu peux simplifier comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range
 
Application.ScreenUpdating = False
If Not Intersect(Target, Columns(3)) Is Nothing Then
    If Target.Count = 1 Then
        Set c = Sheets("Specialfees").Range("E:E").Find(Target.Value, lookat:=xlWhole)
        Application.EnableEvents = False
        If c Is Nothing Then
            Target.Offset(0, 2).ClearContents
        Else
            Target.Offset(0, 2).Value = c.Offset(0, 2).Value
            Set c = Nothing
        End If
        Application.EnableEvents = True
        Target.Offset(0, 1).Select
    End If
End If
End Sub

09/12/2010, 22h18
Djromé

Salut Mercatog,

Effectivement, c'est plus fluide!

Merci
09/12/2010, 22h30
mercatog
Et en plus, tu bloque l'évènement Change quand la macro change Target.offset(0,2) à l'aide de
Code:

1 2 3 Application.EnableEvents = False 'code qui écrit dans la feuille Application.EnableEvents = True
une autre correction de l'orthographe: дурака учить, что мертвого лечить
10/12/2010, 13h24
Djromé

Salut Mercatog,

Juste pour bien comprendre:

Citation:

Et en plus, tu bloque l'évènement Change quand la macro change Target.offset(0,2) à l'aide de
Code :
Application.EnableEvents = False
'code qui écrit dans la feuille
Application.EnableEvents = True

Comme dans ma macro je souhaitai que l'évènement Change n'intervienne que dans la colonne C, il me fallait bloquer par Application.EnanbleEvents =False & True les autres changements qu'effectuera la macro sur des cellules d'autres colonnes dont l'évènement Worksheet.Change aurait forcément pris en compte (d'où mon bug non pas dans la macro mais lorsque je sélectionnais toute la ligne).
En tout cas merci vraiment pour les explications qui elles seulement peuvent nous faire progresser en comprenant mieux se que nous faisons (en tout cas je fonctionne "malheureusement pour moi" de cette manière :oops:.

Quand à la grammaire Russe, j'avoue n'avoir appris à lire et écrire que basiquement (origine éloignée) :aie:

Code 1:
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Not Intersect(Target, Columns(3)) Is Nothing Then Range("D1").Value = "toto" End If End Sub
Code 2:
Code:

1 2 3 4 5 6 7 8 9 Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Not Intersect(Target, Columns(3)) Is Nothing Then Application.EnableEvents = False Range("D1").Value = "toto" Application.EnableEvents = True End If End Sub
Déroulement du Code 1:
Si on écrit dans une cellule de la colonne C, le code est exécuté. il écrit toto en D1, donc changement sur la feuille, donc appel de la sub une 2ème fois qui vérifie que D n'appartient pas à la colonne C. le 2ème appel de la sub se termine et l'appel initial continu. (en fin de compte 2 appels chevauchés)

Déroulement du Code 2:
Si on écrit dans une cellule de la colonne C, le code est exécuté. il écrit toto en D1, donc changement sur la feuille, mais les évènements sont inhibés par Application.EnableEvents = False, donc il n'y a pas d'appel de la sub une 2ème fois et l'appel initial continu. (en fin de compte un seul appel).

J'espère pouvoir bien expliquer.

12/12/2010, 12h56
Djromé

Oui, c'est très clair Mercatog,

Je pense donc devoir bien retenir cette application qui doit être fortement utilisé pour tous les Sub évènements (selectionchange, activate, etc...).
Merci vraiment et malheureusement pour vous à bientôt pour un autre topic! :oops: