Petite macro qui me plante Excel sur tous les PC
Re,
Je passerai un fichier sans les infos condifentielles pour pouvoir travailler dessus plus facilement.
bonjour, il faut limiter target au cellules de la plage A15:A25 ! Si on modifie plusieurs cellules en même temps et la première cellule est hors cette plage, il se passe des choses imprévues. Donc il faut créer un boucle avec l'intersect
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c, cl
Set c = Intersect(Target, Range("A15:A25")) 'les cellules modifiée de cette plage
If Not c Is Nothing Then 'il y a des cellules modifiées dans cette plage
Application.ScreenUpdating = False
For Each cl In c.Cells 'pour chaque cellule modifiée
If cl.Offset(, 8).Value = cl.Offset(, 11) Then X = -1 Else X = cl.Offset(, 8).Value ' si I = L then X=-1 ou X=I
Select Case X 'dépendant de la valeur de X, on change les cellules J-L
Case Is > 0: cl.Offset(0, 9).Resize(, 3) = Array(Format(Now, "dd/mm/yy"), Format(Now, "hh:mm;@"), cl.Offset(, 8).Value) 'J=date, K=heure, L=I
Case Is = 0: cl.Offset(0, 9).Resize(, 3).Clear 'RAZ J-L
End Select
Next
Application.Goto .Offset(0, 9) 'positionnez dans dernière cellule J modifiée
End If
End SubA nouveau,
Donc il faut créer un boucle avec l'intersect
Pas besoin de boucle
Rappel:
Ce que je souhaitais faire c'était d'introduire la date et heure à laquelle la ligne a été renseignée
Et le Target.count = 1 est suffisant.
amaai, est-ce qu'on essaie à créer quelque chose qui est idiot proof ou pas ?
target.count= 1 est une sorte de politique d'autruche pour camoufler ses défauts.
Bonjour BsAlv,
encore une fois merci pour ton retour.
Il y a un bug avec le dernier code:
J'ai testé différente solutions mais je tombe toujours dans l'erreur:
Je continue de tester. Et surtout de préparer un fichier que je puisse joindre mais je dois le faire depuis un autre portable. Ce soir j'essaie de joindre le fichier.
Encore merci.
Patrick.
bonjour, j'avais oublié le "cl"
Application.Goto cl.Offset(0, 9) 'positionnez dans dernière cellule J modifiéeBonjour à tous,
Il y a un bug avec le dernier code:
Un petit oubli entre Goto et .Offset(0,9) ??
Application.Goto cl.Offset(0, 9)[EDIT] : Bonjour BsAlv ,
Cordialement,
BsAlv, le fil, bonjour à tous,
Je continue de creuser un peu afin d'obtenir ce que je souhaite obtenir! En tout cas merci pour vos réponses qui m'ont déjà bien aidé.
J'avais développé une macro (qui fonctionne et j'en suis bien content) mais qui entre en "conflit" avec celle que me propose BsAlv (qui fonctionne parfaitement
On prend la code de BsAlv:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c, cl
Set c = Intersect(Target, Range("A15:A25")) 'les cellules modifiée de cette plage
If Not c Is Nothing Then 'il y a des cellules modifiées dans cette plage
Application.ScreenUpdating = False
For Each cl In c.Cells 'pour chaque cellule modifiée
If cl.Offset(, 8).Value = cl.Offset(, 11) Then X = -1 Else X = cl.Offset(, 8).Value ' si I = L then X=-1 ou X=I
Select Case X 'dépendant de la valeur de X, on change les cellules J-L
Case Is > 0: cl.Offset(0, 9).Resize(, 3) = Array(Format(Now, "dd/mm/yy"), Format(Now, "hh:mm;@"), cl.Offset(, 8).Value) 'J=date, K=heure, L=I
Case Is = 0: cl.Offset(0, 9).Resize(, 3).Clear 'RAZ J-L
End Select
Next
'Application.Goto cl.Offset(0, 9) 'positionnez dans dernière cellule J modifiée
End If
End SubPetite parenthèse: Je mets le code ci-dessous en ' car il me donne erreur:
'Application.Goto cl.Offset(0, 9) 'positionnez dans dernière cellule J modifiéeMon code sert lui à éviter qu'il y ait deux fois la même référence et évite ainsi les doublons:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Détecte les doublons sur la colonne I et renvoie un message d'erreur.
Dim Lg%, X%
Lg = Range("i6500").End(xlUp).Row
If Not Application.Intersect(Target, Range("i8:i" & Lg)) Is Nothing Then
If Application.CountIf(Range("i:i"), Target) > 1 Then
X = Application.Match(Target, Range("i:i"), 0)
If X = Target.Row Then
X = Application.Match(Target, Range(Target.Offset(1, 0), Cells(Lg, 1)), 0) + Target.Row
End If
MsgBox ("Cette référence a déjà été scannée sur la" & Chr(10) & "ligne " & X), vbExclamation, "GESTION DES SCANS: DOUBLON"
'Cells(x, 1).Select
Target.ClearContents
ActiveSheet.Cells(Rows.Count, "I").End(xlUp)(2).Select
End If
End If
End SubCes deux codes, sur des feuilles différentes fonctionnent. Par contre, l'un après l'autre , pas.... Je suis conscient qu'il faut enlever
Private Sub Worksheet_Change(ByVal Target As Range)Comment faire donc pour que ces deux Worksheet_change cohabitent?
J'ai testé plusieurs options dont celle-ci avec un Exit Sub mais:
J'apprécierais encore une fois votre aide.
Merci par avance.
Patrick.
Bonjour PatPatrouille,
D'abord le code est une reprise de ma proposition auquel Bsalv a mis une boucle.
Donc forcément qu'il trouve des doublons dans la boucle.
Je rappelle que si les modifications se font une par une, il n'existe pas de souci.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%
If Not Intersect(Target, Range("A15:A25")) Is Nothing and Target.count= 1 Then
Application.ScreenUpdating = False
'Conditions
If Target = Target(0, 11) Then X = -1 Else X = Target
Select Case X
Case Is > 0
Target.Offset(0, 10) = Format(Now, "hh:mm;@")
Target.Offset(0, 9) = Format(Now, "dd/mm/yy")
'case Test, doublon de la colonne I
Target.Offset(0, 11) = Target
Case Is = 0
'RAZ Date/Heure et du Test
For i = 9 To 11
Target.Offset(0, i).Clear
Next i
Case Else
'Nothing
End Select
Target.Offset(0, 9).Activate
Application.ScreenUpdating = True
End If
End SubBonjour X Cellus,
Mes excuses, j'avais en un premier temps copier la réponse de BsAlv.... Pardon pour ce mal entendu.
Concernant le code, il fonctionne et c'est vraiment top. Mais comme je le dis dans mon précédent message, il entre en conflit avec un code que j'avais déjà créé et me retourne une erreur:
Car, effectivement il y a :
Private Sub Worksheet_Change(ByVal Target As Range)et
Private Sub Worksheet_Change(ByVal Target As Excel.Range)Ma question était donc de savoir comment faire pour unir ces deux codes sous un seul
Private Sub Worksheet_Change(ByVal Target As Range)D'avance merci et encore toutes mes excuses.
Patrick.
@X Cellus, il faut connaitre l'histoire de cette question, quelque postes avant votre premier poste j'avais déjà donner cette fameuse macro "change" avec boucle, qui est pour moi une macro de niveau basic. Apparament, on ne peut pas dire la vérité ici ! Ce boucle est nécessaire parce qu'on ne peut pas demander aux utilisateurs de changer les cellules une par une. Je suis certain qu'ils font cela dans 99.9% des cas et dans ces cas votre macro est okay mais un moment donné, ils sont bêtes, rien à faire ... et à ce moment le boucle doit faire son boulot et vous ne pouvez pas chercher des excuses. Il n'y a pas de discussion possible à ce point là.
Bon, pour les doublons, ce n'est pas vraiment nécessaire, mais je blocque les évents un moment et dans le cas où la macro n'est pas bien terminée, il faut réactiver les events avec la macro "Eon"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c, cl, s
Set c = Intersect(Target, Range("A15:A25")) 'les cellules modifiée de cette plage
Me.Range("I8:I6500").Name = "Scan" 'plage pour vérifier les doublons
If Not c Is Nothing Then 'il y a des cellules modifiées dans cette plage
Application.EnableEvents = False 'blocquer les events
For Each cl In c.Cells 'pour chaque cellule modifiée
If cl.Offset(, 8).Value = cl.Offset(, 11) Then X = -1 Else X = cl.Offset(, 8).Value ' si I = L then X=-1 ou X=I
Select Case X 'dépendant de la valeur de X, on change les cellules J-L
Case Is > 0:
cl.Name = "ScanValue" 'valeur du scan actuel
cl.Offset(0, 9).Resize(, 3) = Array(Format(Now, "dd/mm/yy"), Format(Now, "hh:mm;@"), cl.Offset(, 8).Value) 'J=date, K=heure, L=I
fl = Filter([transpose(if(scan=scanvalue,row(scan),"~"))], "~", 0) 'filtrer toutes les lignes avec le même scan-valeur
If UBound(fl) > 0 Then s = s & vbLf & vbLf & "Scanvalue : " & cl.Value & " dans cellule " & cl.Address & vbLf & "lignes doublons : " & Join(fl) 's'il y a plusieurs cellules avec le même valeur ...
Case Is = 0: cl.Offset(0, 9).Resize(, 3).Clear 'RAZ J-L
End Select
Application.Goto cl.Offset(0, 9) 'positionnez dans dernière cellule J modifiée
Next
Application.EnableEvents = True
End If
If Len(s) > 0 Then MsgBox Mid(s, 3), vbExclamation, "GESTION DES SCANS: DOUBLON"
End SubA nouveau,
il faut connaitre l'histoire de cette question, quelque postes avant votre premier poste j'avais déjà donner cette fameuse macro "change" avec boucle
@Bslav. Il faut surtout être honnête. Voilà, ta boucle sur ton code hors du contexte puisque les dates étaient toutes actualisées.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Set c = Intersect(Target, Range("I15:I25")) 'seulement les cellules changées de la plage I15:I25)
If Not c Is Nothing Then
Application.EnableEvents = False 'blocquer events
For Each cl In c.Cells 'boucle ces cellules modifiée
If cl.Value > 0 Then 'non vide
cl.Offset(, 2).Value = Format(Time, "hh:mm;@") '2 cellules vers droite
cl.Offset(, 1).Value = Format(Date, "dd/mm/yy") '1 cellule vers droite
Else
cl.Offset(, 1).Resize(, 2).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Subinutile de discuter, à la prochain.
BsAlv, X Cellus,
ça me désole quelque peu ces derniers messages. Les deux vous m'avez énormément aidé !! Un forum est un lieu de partage, peu importe qui fait quoi qui fait mieux! Chacun de vous avez apporté de bonnes réponses. La preuve, l'un rejoint l'autre sur la solution et c'est cela que qu'il faut retenir. L'union fait la force les gars!
Sincèrement, si nous habitions la même ville, je vous inviterais les deux à plusieurs bières!! C'est toujours plus sympas de rigoler que de s'e foutre plein la gu....
D'ailleurs, je souhaiterais vous remercier en privé pour votre contribution et le temps employé à trouver une solution pour cette "maudite" macro qui ne veut pas fonctionner :-) Un petit message privé vous seras remis.
Bon, je vais tester le dernier code remis voir si ça marche Bon Dieu!! Je vous tiens au jus.
Et, une fois encore, merci A VOUS DEUX.
Re et sûrement une dernière fois sur ce fil:
On va prendre le code qui fonctionne:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c, cl
Set c = Intersect(Target, Range("A15:A25")) 'les cellules modifiée de cette plage
If Not c Is Nothing Then 'il y a des cellules modifiées dans cette plage
Application.ScreenUpdating = False
For Each cl In c.Cells 'pour chaque cellule modifiée
If cl.Offset(, 8).Value = cl.Offset(, 11) Then X = -1 Else X = cl.Offset(, 8).Value ' si I = L then X=-1 ou X=I
Select Case X 'dépendant de la valeur de X, on change les cellules J-L
Case Is > 0: cl.Offset(0, 20).Resize(, 3) = Array(Format(Now, "dd/mm/yy"), Format(Now, "hh:mm;@"), cl.Offset(, 8).Value) 'J=date, K=heure, L=I
Case Is = 0: cl.Offset(0, 20).Resize(, 3).Clear 'RAZ J-L
End Select
Next
'Application.Goto cl.Offset(0, 9) 'positionnez dans dernière cellule J modifiée
End If
Exit Sub
End SubMaintenant, pour faire simple: sur ce code, imaginons que les cellules qui changent sont sur une autre feuille nommée "test". Si A15:A25 changent dans "test", alors on exécute le reste du code. J'ai testé cela mais sans succès:
Set c = Intersect(Target, Sheets("test"), Range("A15:A25")) 'les cellules modifiée de cette plageUne fois cela fait je pense ne plus vous déranger. Puis Je me mettrai en contact avec vous pour vous remercier par le biais d'un petit quelque chose...
Merci.
Patrick.
Bonjour Patrick,
Tu ne semble pas comprendre ce qu'est un évènement et comment il s'applique
L'évènement Change, ne peut s'appliquer qu'à la feuille en question, sinon il faut utiliser cet évènement dans ThisWorkbook
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
End SubDans la sub "Sh" représente l'objet feuille dans laquelle est faite la modification
J'espère que cela pourra t'aider
A+
bonjour PatPatrouille, BrunoM45, le fil,
Un évenement "change" n'est seulement pour les cellules sans formules, donc avec la macro "...Change..." dans le module d'une feuille ou dans thisworkbook, on ne détecte jamais une cellule qui change parce que une autre cellule change de valeur. On ne voit que les cellules changées par intervention physique (humaine, VBA , ...).
On a le choix pour détecter ces changements dans le module d'une feuille, mais cette macro ne détecte que les changements de cette feuille ou bien dans le module de thisworkbook, avec laquelle on couvre toutes les changements de chaque feuille, mais aussi plus difficile à gèrer.
Bon, cette macro est la 2ième option. Pour mieux comprendre le fonctionnement, mettez un point d'arrêt à la première ligne de cette macro avec F9 (Msgbox ...) et puis step-by-step avec F8 pour voire ce qu'il se passe.
Parfois, on n'aime pas qu'un évenement se produit, alors on sait blocqué cela avec "Application.EnableEvents = False" et puis (n'oubliez pas !!!) déblocquer avec "True".
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c, cl, X
MsgBox "feuille : " & Sh.Name & vbLf & "plage : " & Target.Address, vbInformation, "Modification cellules sans formules"
Select Case LCase(Sh.Name) 'vérifier le nom de la feuille en MINISCULES
Case "feuil1" 'vous modifiez quelque chose dans la feuille "Feuil1"
Set c = Intersect(Target, Sh.Range("A15:A25")) 'les cellules modifiée de cette plage
If Not c Is Nothing Then 'il y a des cellules modifiées dans cette plage
Application.ScreenUpdating = False
For Each cl In c.Cells 'pour chaque cellule modifiée
If cl.Offset(, 8).Value = cl.Offset(, 11) Then X = -1 Else X = cl.Offset(, 8).Value ' si I = L then X=-1 ou X=I
Select Case X 'dépendant de la valeur de X, on change les cellules J-L
Case Is > 0: cl.Offset(0, 20).Resize(, 3) = Array(Format(Now, "dd/mm/yy"), Format(Now, "hh:mm;@"), cl.Offset(, 8).Value) 'J=date, K=heure, L=I
Case Is = 0: cl.Offset(0, 20).Resize(, 3).Clear 'RAZ J-L
End Select
Next
End If
Case "feuil2" 'vous modifiez quelque chose dans la feuil2
Set c = Intersect(Target, Sh.Range("A15:A25")) 'les cellules modifiée de cette plage
If Not c Is Nothing Then 'il y a des cellules modifiées dans cette plage
Application.EnableEvents = False
Sheets("Feuil1").Range("O1:O15").Value = "VBA changement sans event " & Format(Now, "hh:mm:ss")
Application.EnableEvents = True
Sheets("Feuil1").Range("P1:P15").Value = "VBA changement avec event " & Format(Now, "hh:mm:ss")
End If
End Select
End SubBsAlv,
merci pour cette dernière réponse.
Petit message privé pour te remercier personnellement.
Patrick.
BsAlv,
J'ai étudié tout le code que tu as gracieusement remis avec le fichier annexé. C'est parfait, il fonctionne!! Maintenant, je souhaite l'adapter à mon fichier mais après plus de deux heures d'études, d'essaies, de test... je bloque. Je bloque et je n'arrive pas à avancer malgré plusieurs recherches sur les sites de développement. Une dernière fois, sans volonté d'abuser de ton temps. Faisons simple et adaptons cela. Je voulais vraiment trouver par moi-même la solution mais je n'y arrive pas ce qui est encore plus frustrant.
Ma feuille se nomme SCAN (en majuscules) . Déjà là je bug car dès que je modifie le nom de la feuille, de l'onglet et la macro avec ce nom-là mais plus rien ne se passe.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c, cl, X
Select Case LCase(Sh.Name) 'vérifier le nom de la feuille en MINISCULES
Case "SCAN" 'vous modifiez quelque chose dans la feuille "SCAN"Par la suite, sur la feuille SCAN, ce sont les cellules de i8 à i70 qui peuvent être modifiées sur mon fichier:
Set c = Intersect(Target, Sh.Range("i8:i70")) 'les cellules modifiée de cette plagePuis, les cellules où doivent apparaître la date et l'heure sont U et V comme dans ton fichier à toi. Par contre je n'ai pas besoin que dans W il y ait une copie de ce qui est dans i. On reste donc uniquement avec la date et l'heure dans U et V quand i est modifiée.
En résumé c'est cela: Quant i est modifiée, U reçoit la date et V reçoit l'heure.
Actuellement, dans ton fichier, quand on modifie A, U reçoit la date, V reçoit l'heure et W reçoit la copie de i.
Finalement, pour simplifier, je n'ai pas besoin de ça:
Case "feuil2" 'vous modifiez quelque chose dans la feuil2
Set c = Intersect(Target, Sh.Range("A15:A25")) 'les cellules modifiée de cette plage
If Not c Is Nothing Then 'il y a des cellules modifiées dans cette plage
Application.EnableEvents = False
Sheets("Feuil1").Range("O1:O15").Value = "VBA changement sans event " & Format(Now, "hh:mm:ss")
Application.EnableEvents = True
Sheets("Feuil1").Range("P1:P15").Value = "VBA changement avec event " & Format(Now, "hh:mm:ss")
End If
End SelectOn reste donc que sur la feuille SCAN.
Voilà, comme déjà indiqué, je te remercie pour tout ton temps.
Je me tiens à ta disposition pour tout complément d'informaion.
Patrick.