XL 2013 Macro pour ajouter un commentaire automatique

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:

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

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

kev972

XLDnaute Nouveau
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+
Merci beaucoup. Je m’occupe demain de mettre cela en place.
 

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

job75

XLDnaute Barbatruc
Bonjour kev972,
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.
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

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

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 ;)
 

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

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+
 

kev972

XLDnaute Nouveau
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+
Ok super merci!
 

Discussions similaires

Statistiques des forums

Discussions
312 104
Messages
2 085 349
Membres
102 869
dernier inscrit
radyreth