XL 2013 Macro pour ajouter un commentaire automatique

K

kev972

XLDnaute Nouveau
Bonjour,

Désolé je débute à peine sur les macros et je n'ai aucune notion
J'ai récupéré un fichier excel à mon travail qui sert à importer un fichier généré chaque jour et à mettre en évidences les anomalies. (Macro déjà existante)
J'ai ajouté sur une nouvelle feuille un tableau de toutes les anomalies possibles avec une cellule commentaire.
Mon but est que lorsque j'importe le fichier, si il y a une anomalie recensé dans le tableau le commentaire du tableau se mette directement en commentaire de la ligne.
Par exemple, j'ai dans mon tableau Pain en B3 et viande en B4 avec en B5 un commentaire DANGER, je voudrais quand j'importe mon fichier s'il y a pain et viande, DANGER se mette directement
Comment puis je faire?
Merci d'avance
 
Dernière édition:
Trier par date Trier par votes
K

kev972

XLDnaute Nouveau
Bonjour,

Désolé de ma réponse tardive et de mon énoncé peu lisible.
Je vais essayé d'être plus clair.
Tous les jours, nous exportons environs 2000 informations sur les évènements passés la veille dans l'usine. Cet export se fait automatiquement chaque matin sous forme d'un nouveau fichier Excel (A) généré. Chaque jour, c'est un nouveau fichier qui est généré par notre logiciel et il n'était donc pas possible de réaliser des macros dessus.
Sur un deuxième fichier (B), nous avons fait des macros qui permettent d'importer le fichier A et de faire des filtres automatiques sur les informations pour faire apparaitre que les primordiales.
Via un bouton Copier/coller, mon fichier excel B récupère toutes les informations de mon fichier excel A et filtre directement sur les infos qui me sont nécessaires.
Mon but est de rajouter un commentaire automatique dès qu'une ligne contient l'information X, Y ou Z...
Dans le fichier exemple, si jamais lors de mon import le fichier contient PAIN, je voudrais que le commentaire mis en feuille 2 sur PAIN se mette directement sur la feuille 1.
J'espère avoir été plus clair.
J'ai joins un fichier exemple brut.

Merci beaucoup pour votre aide
 

Pièces jointes

  • exemple.xlsx
    8.7 KB · Affichages: 7
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour kev972, fanch55,

Voyez le fichier .xlsm joint et le code de la 1ère feuille :
VB: 
Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil2 'CodeName; à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("B5:C" & .Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            x = tablo(i, 1)
            If x <> "" Then d(x) = tablo(i, 2)
        Next
    End With
End With
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("B3:C" & Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        tablo(i, 2) = d(tablo(i, 1))
    Next
    '---restitution---
    Application.EnableEvents = False 'désactive les évènements
    .Value = tablo
    Application.EnableEvents = True 'réactive les évènements
    .EntireColumn.AutoFit 'ajuste les largeurs de colonnes
End With
End Sub
Il s'exécute automatiquement quand on valide ou modifie une cellule quelconque ou qu'on active la feuille.

L'exécution est très rapide car on utilise le Dictionary et un tableau VBA, aucun problème sur 2000 lignes.

A+
 

Pièces jointes

  • exemple(1).xlsm
    18.9 KB · Affichages: 11
Vote positif 0 Vote négatif
K

kev972

XLDnaute Nouveau
job75 à dit:
Bonjour kev972, fanch55,

Voyez le fichier .xlsm joint et le code de la 1ère feuille :
VB: 
Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil2 'CodeName; à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("B5:C" & .Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            x = tablo(i, 1)
            If x <> "" Then d(x) = tablo(i, 2)
        Next
    End With
End With
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("B3:C" & Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        tablo(i, 2) = d(tablo(i, 1))
    Next
    '---restitution---
    Application.EnableEvents = False 'désactive les évènements
    .Value = tablo
    Application.EnableEvents = True 'réactive les évènements
    .EntireColumn.AutoFit 'ajuste les largeurs de colonnes
End With
End Sub
Il s'exécute automatiquement quand on valide ou modifie une cellule quelconque ou qu'on active la feuille.

L'exécution est très rapide car on utilise le Dictionary et un tableau VBA, aucun problème sur 2000 lignes.

A+
Cliquez pour agrandir...
Merci beaucoup. Je m’occupe demain de mettre cela en place.
 
Vote positif 0 Vote négatif
K

kev972

XLDnaute Nouveau
Bonjour,
La macro marche super bien sauf que je voulais la modifier pour que le commentaire se mette en cellule N et non C et ca ne marche pas.
J'ai mis aussi en pièce jointe le fichier final sur lequel je travail.
Désolé et encore merci
 

Pièces jointes

  • Copie Copie de Ext Extrapolt 5.38.xlsm
    218.4 KB · Affichages: 2
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour kev972,
kev972 à dit:
La macro marche super bien sauf que je voulais la modifier pour que le commentaire se mette en cellule N et non C et ca ne marche pas.
Cliquez pour agrandir...
Pourtant vous semblez être un stakhanoviste du VBA !!!

Les tableaux commencent en ligne 4 sur Feuil4 et en ligne 10 sur la feuille "Extraction" donc :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil4 'CodeName, à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("B4:C" & .Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            x = tablo(i, 1)
            If x <> "" Then d(x) = tablo(i, 2)
        Next
    End With
End With
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("B10:N" & Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
    tablo = .Formula 'matrice, plus rapide, Formula car il y a peut-être des formules
    For i = 1 To UBound(tablo)
        tablo(i, 13) = d(tablo(i, 1)) 'en colonne N
    Next
    '---restitution---
    Application.EnableEvents = False 'désactive les évènements
    .Formula = tablo
    Application.EnableEvents = True 'réactive les évènements
    .EntireColumn.AutoFit 'ajuste les largeurs de colonnes
End With
End Sub
J'utilise Formula car il peut y avoir des formules dans les colonnes intermédiaires.

A+
 

Pièces jointes

  • Copie Copie de Ext Extrapolt 5.38.xlsm
    223.5 KB · Affichages: 3
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Mais restituer les 13 colonnes de B à N prend du temps, il vaut mieux utiliser le tableau resu (1 colonne) :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, x$, resu()
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil4 'CodeName, à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("B4:C" & .Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
        tablo = .Value 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            x = CStr(tablo(i, 1)) 'texte
            If x <> "" Then d(x) = tablo(i, 2)
        Next
    End With
End With
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("B10:B" & Range("B" & Rows.Count).End(xlUp).Row) 'plage à adapter
    tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 1)
    For i = 1 To UBound(resu)
        resu(i, 1) = d(CStr(tablo(i, 1))) 'convertit les nombres en textes
    Next
    '---restitution---
    Application.EnableEvents = False 'désactive les évènements
    .Columns(13) = resu 'en colonne N
    Application.EnableEvents = True 'réactive les évènements
    .EntireColumn.AutoFit 'ajuste les largeurs de colonnes
End With
End Sub
Les clés x du Dictionary étant des textes j'utilise CStr pour convertir les nombres en textes.
 

Pièces jointes

  • Copie Copie de Ext Extrapolt 5.38.xlsm
    223.9 KB · Affichages: 2
Vote positif 0 Vote négatif
K

kev972

XLDnaute Nouveau
Merci pou votre retour et désolé j'étais en déplacement en fin de semaine.
J'essaie de m'approprier la Macro mais c'est très compliqué quand on a pas les bases!😁.. La persévérance est le début de la rançon de la gloire.
Je vais essayé de l'exploiter comme ça et de faire des améliorations si besoin. J'hésiterais pas à vous solliciter ;)
 
Vote positif 0 Vote négatif
K

kev972

XLDnaute Nouveau
Bonjour, je suis déjà de retour. J'ai deux questions:
- La macro marche très bien mais Vu que je n'ai que deux choix de réponse (Coupure/Risque de coupure), est ce que c'était plus pertinent de créer une macro avec If, else ?
- Sur une nouvelle feuille je voudrais réaliser un même type de macro, dont le but est que lorsque j'écris un mot (ROR,...) le texte se rajoute automatiquement en dessous. J'ai préparé sur une nouvelle feuille le texte et les mots (feuil6) et je voudrais réaliser la macro sur la feuil3? Est ce possible?
 

Pièces jointes

  • Copie Copie de Ext Extrapolt 5.38.xlsm
    192.4 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour kev972,

Pour la 1ère question s'il n'y a que 2 possibilités figées le VBA n'est pas nécessaire.

Sur le fichier du post #10 effacez le code de la feuille "Extraction" et entrez en N10 la formule :
Code: 
=SI(ESTNUM(B10);SI(ET(B10>=11;B10<=26);"Risque de coupure";"COUPURE");"")
à tirer vers le bas.

Pour la 2ème question je n'ai rien compris mais comme c'est un nouveau problème vous devez créer une nouvelle discussion, comme le préconise la Charte du forum.

A+
 
Vote positif 0 Vote négatif
K

kev972

XLDnaute Nouveau
job75 à dit:
Bonjour kev972,

Pour la 1ère question s'il n'y a que 2 possibilités figées le VBA n'est pas nécessaire.

Sur le fichier du post #10 effacez le code de la feuille "Extraction" et entrez en N10 la formule :
Code: 
=SI(ESTNUM(B10);SI(ET(B10>=11;B10<=26);"Risque de coupure";"COUPURE");"")
à tirer vers le bas.

Pour la 2ème question je n'ai rien compris mais comme c'est un nouveau problème vous devez créer une nouvelle discussion, comme le préconise la Charte du forum.

A+
Cliquez pour agrandir...
Ok super merci!
 
Vote positif 0 Vote négatif

Discussions similaires

jeff1494
  • Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
AtTheOne
J
  • Résolu(e)
XL 2019 Détection de texte dans une Cellule pour le Copier et Coller dans un autre tableau
2 3
Réponses
40
Affichages
1 K
Phil69970
Phil69970
L
  • Résolu(e)
XL 2016 Formule pour calculer une somme avec des plages décalées
Réponses
2
Affichages
221
Linda42
L
P
  • Question
Microsoft 365 lancer une macro excel tous les jour sans ouvrir le fichier
Réponses
6
Affichages
972
patricktoulon
patricktoulon
J
  • Résolu(e)
XL 2013 Créer une macro avec un fichier pour envoyer par mail
Réponses
7
Affichages
272
TooFatBoy
TooFatBoy
halecs93
  • Résolu(e)
XL 2016 ajouter des lignes à un tableau "formules matricielles"
Réponses
2
Affichages
296
halecs93
halecs93
Z
  • Résolu(e)
XL 2021 Faire clignoter un texte spécifique dans les cellules d'une colonne
Réponses
4
Affichages
392
ZE21000
Z
J
  • Question
XL 2021 excel - vbs - csv
2
Réponses
28
Affichages
1 K
jerome1980
J
B
  • Question
XL 2010 Ajouter des lignes dans tableau avec une macro
Réponses
13
Affichages
498
Boyoh
B
J
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
549
JacquesO
J

Membres actuellement en ligne

7 membres et 82 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 588
Messages
2 110 988
Membres
111 002
dernier inscrit
Lolo73i