XL 2016 Un coup de pousse pour finaliser macro VBA

[jh_kd]

Bonjour le forum!

Voici ma macro qui ajoute des données des membres (NewKDI) aux données nouvelles de logs (LogsKDI).

Sub Test()
Dim I As Integer, Cellule As Range
With Sheets("LogsKDI")
For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row
Set Cellule = Sheets("NewKDI").Cells.Find(What:=Range("T" & I), LookAt:=xlPart)
If Not Cellule Is Nothing Then .Range("E" & I) = Replace(Cellule.Address, "", "T")
Next I
End With
End Sub

Je suis presque au bout, mais je bloque sur la fin.
En effet, dans la colonne "E", il me met ligne à ligne la lettre T et un nombre incrémenté de 1 (mon code Replace(Cellule.Address, "", "T") est faux).

Alors que je voudrais qu'il aille chercher le contenu de la colonne T dans l'autre feuille NewKDI à la ligne où il a trouvé l'unique occurrence (avant de passer à la ligne suivante)

A coup sûr facile pour vous!

Merci de votre aide

Cordialement

JH

 

[Compte Supprimé 979]

Bonjour jh_kd

Merci d'éditer votre post et de mettre le code entre balises avec le bouton

A+

 

[jh_kd]

Oh, oh, merci barbatruc, Stéphanie m'avait parlé de vous il y a des années.
Vous êtes fidèle au poste.
Comme c'est mon 2ème message seulement j'avais zappé!
C'est corrigé.
A vous lire.
Cordialement
JH

 

[Compte Supprimé 979]

Re,

Stéphanie navré pour elle, je en vois pas qui c'est

Sub Test()
  Dim I As Integer, Cellule As Range
  With Sheets("LogsKDI")
    For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      Set Cellule = Sheets("NewKDI").Cells.Find(What:=Range("T" & I).Value, LookAt:=xlPart)
      If Not Cellule Is Nothing Then .Range("E" & I) = Cellule.Value
    Next I
  End With
End Sub

Si j'ai bien tout, compris, le code devrait être comme ceci

A+

 

[jh_kd]

Bonjour Barbatruc,

Ah Stéphanie est inscrite sur ce forum comme stephsteph, elle ne fait plus d'Excel, mais elle continue à s'occuper de ses jeunes en difficultés.

Pour l'anecdote, elle m'aidait bénévolement durant la grande époque de Pierre Jean et après pour faire (avec vous par exemple, je crois, en tous cas elle m'a cité votre nom, barbatruc qui ne s'invente pas) des macros très utiles pour mes sites web.
Seulement voilà moi je suis vraiment pas doué (et actuellement en convalescence, donc brumeux).
Ma macro est déjà fausse car en l'appliquant avec votre code, le tout dans la colonne 5 de LogsKDI reste vide!
Même après une correction mineure à Range("AB" & I) pour la colonne 28 au lieu de "T", ici.
Et en plus je vois que cellule.value devrait concerner la ligne de la colonne 20 ("T") et pas la 28 qui sert à la recherche!

La macro que j'ai tentée de faire concerne un fichier, avec plusieurs feuilles.
Une feuille, principale, NewKDI, dans laquelle figurent, sauf la ligne d'en tête 1, en colonne 12, un "0" ou un "1", en colonne 23, un entier croissant, en colonne 28 un identifiant différent à chaque ligne et en colonne 20 une adresse mail différente à chaque ligne
Une autre feuille LogsKDI, de monitoring, déjà triée sur la colonne 1, dans laquelle figurent (une ligne 1, de titre) en colonne 1 un identifiant qui peut se répéter (le même que dans NewKDI dans la colonne 28).
Je voudrais que dans cette même feuille LogsKDI soient remplies de nouvelles données:
Ajouter dans LogsKDI en colonne 5 l'adresse mail de la colonne 20, en colonne 6 le numéro de la colonne 23, un entier et en colonne 7 le 0 ou 1 de la de la colonne 12, tous 3 issus de la feuille NewKDI, correspondants au même identifiant de la feuille LogsKDI
Pour l'instant, je ne me suis occupé que de la colonne 20 ("T") pour la colonne 5 de LogsKDI

Avant je pouvais tester mes essais en pas à pas avec F8 mais avec ma nouvelle version XL 2019 cela ne marche plus (j'ai cherché sur Internet sans succès).

Voilà vous savez tout.

Cordialement
JH

 

[Compte Supprimé 979]

Re,

Ah oui d'accord, j'espère qu'elle va bien... c'est vrai qu'on ne l'a pas vu depuis 2017 apparemment.

Pour votre problématique, ce qui serait bien alors, c'est de nous joindre un fichier anonymisé de quelques lignes avec un exemple de ce que vous souhaiteriez avoir

A+

 

[jh_kd]

Bonjour Barbatruc,

Merci de votre aide

Bien sûr.

Voici en fichier attaché, les 2 feuilles remplies avec des données minimales et fictives (CNIL oblige).
J'ai aussi mis une feuille Exemple pour montrer ce que j'attends (fait manuellement).
Dernier rebondissement, si je met la cellule en A1 pour les 2 feuilles, que je met le curseur sur NewKDI (pas sur sur LogsKDI!!!) et que je lance la macro alors j'ai un résultat en colonne E mais c'est n'importe quoi. Testez!
Ma macro a de sérieux problèmes.

Cordialement
JH

PS: je n'ai pas de nouvelles de Stéphanie depuis le 2ème confinement: avec son métier elle était exténuée.

 

[Compte Supprimé 979]

Re,

Vous vous êtes sacrément mélangé les pinceaux

Voici le code qui fonctionnera correctement pour l'eMail

Sub Test()
  Dim Lig As Integer, Cellule As Range
  Dim sID As String, eMail As String
  ' Avec l'objet conteneur - La Feuille : LogsKDI
  With Sheets("LogsKDI")
    For Lig = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      ' Ne pas oublier le point devant range, pour qu'il soit en relation
      ' avec l'objet conteneur, qui est la feuille LogsKDI
      '
      ' Vérifier si l'ID est le même ou pas
      If sID <> "" And .Range("A" & Lig) = sID Then
        ' Si c'est le même on inscrit le mail mémorisé
        .Range("E" & Lig) = eMail
      Else
        ' Sinon on récupère l'ID
        sID = .Range("A" & Lig).Value
        ' On cherche l'ID dans l'autre feuille en colonne AB
        Set Cellule = Sheets("NewKDI").Range("AB:AB").Find(What:=sID, LookAt:=xlPart)
        ' Si une cellule est trouvée
        If Not Cellule Is Nothing Then
          ' On mémorise l'email de l'ID pour maintenant et après
          eMail = Sheets("NewKDI").Range("T" & Cellule.Row)
          ' On l'inscrit dans la colonne E
          .Range("E" & Lig) = eMail
        End If
      End If
    Next Lig
  End With
End Sub

Ceci dit, une simple formule ferait très bien l'affaire et serait plus rapide

PS : vraiment navré de savoir cela combien sont dans le même cas

A+

 

[jh_kd]

Bonjour Barbatruc,

Merci de votre aide... cela marche!
Oh oui je me suis bien mélangé les pinceaux... tout paraissait si simple!!!

Bon alors j'ai bétonné, plutôt que d'essayer à finasser, j'ai repris le bout de macro 2 autres fois et cela marche!

La macro (redondante, je l'avoue, mais en terme de temps c'est des microsecondes de différence), la voici pour les autres forumistes.

Sub Test3()
  Dim Lig As Integer, Cellule As Range
  Dim sID As String, eMail As String, number As String, agreement As String
  ' Avec l'objet conteneur - La Feuille : LogsKDI
  With Sheets("LogsKDI")
    For Lig = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      ' Ne pas oublier le point devant range, pour qu'il soit en relation
      ' avec l'objet conteneur, qui est la feuille LogsKDI
      '
      ' Vérifier si l'ID est le même ou pas
      If sID <> "" And .Range("A" & Lig) = sID Then
        ' Si c'est le même on inscrit le mail mémorisé
        .Range("E" & Lig) = eMail
      Else
        ' Sinon on récupère l'ID
        sID = .Range("A" & Lig).Value
        ' On cherche l'ID dans l'autre feuille en colonne AB
        Set Cellule = Sheets("NewKDI").Range("AB:AB").Find(What:=sID, LookAt:=xlPart)
        ' Si une cellule est trouvée
        If Not Cellule Is Nothing Then
          ' On mémorise l'email de l'ID pour maintenant et après
          eMail = Sheets("NewKDI").Range("T" & Cellule.Row)
          ' On l'inscrit dans la colonne E
          .Range("E" & Lig) = eMail
        End If
      End If
    Next Lig
  End With
  With Sheets("LogsKDI")
    For Lig = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      ' Ne pas oublier le point devant range, pour qu'il soit en relation
      ' avec l'objet conteneur, qui est la feuille LogsKDI
      '
      ' Vérifier si l'ID est le même ou pas
      If sID <> "" And .Range("A" & Lig) = sID Then
        ' Si c'est le même on inscrit le nombre mémorisé
        .Range("F" & Lig) = number
      Else
        ' Sinon on récupère l'ID
        sID = .Range("A" & Lig).Value
        ' On cherche l'ID dans l'autre feuille en colonne AB
        Set Cellule = Sheets("NewKDI").Range("AB:AB").Find(What:=sID, LookAt:=xlPart)
        ' Si une cellule est trouvée
        If Not Cellule Is Nothing Then
          ' On mémorise le nombre de l'ID pour maintenant et après
          number = Sheets("NewKDI").Range("W" & Cellule.Row)
          ' On l'inscrit dans la colonne F
          .Range("F" & Lig) = number
        End If
      End If
    Next Lig
  End With
  With Sheets("LogsKDI")
    For Lig = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      ' Ne pas oublier le point devant range, pour qu'il soit en relation
      ' avec l'objet conteneur, qui est la feuille LogsKDI
      '
      ' Vérifier si l'ID est le même ou pas
      If sID <> "" And .Range("A" & Lig) = sID Then
        ' Si c'est le même on inscrit le mail mémorisé
        .Range("G" & Lig) = agreement
      Else
        ' Sinon on récupère l'ID
        sID = .Range("A" & Lig).Value
        ' On cherche l'ID dans l'autre feuille en colonne AB
        Set Cellule = Sheets("NewKDI").Range("AB:AB").Find(What:=sID, LookAt:=xlPart)
        ' Si une cellule est trouvée
        If Not Cellule Is Nothing Then
          ' On mémorise l'agreement de l'ID pour maintenant et après
          agreement = Sheets("NewKDI").Range("L" & Cellule.Row)
          ' On l'inscrit dans la colonne E
          .Range("G" & Lig) = agreement
        End If
      End If
    Next Lig
  End With
End Sub

A propos, je ne comprend pas, par curiosité, comment cela serait-il plus facile avec des formules (les ID ne sont correspondent pas ligne à ligne entre les 2 feuilles)???

Merci encore, chapeau bas!

Cordialement
JH

PS: oui on a tous soufferts sauf que pour Stéphanie (un cas très rare) c'est déjà très très difficile en temps normal... mais ce sont ses choix de vie et je crois çà lui va (avec des moments...)

 

[jh_kd]

Bonjour le forum,

Après avoir bétonné, j'ai pris le temps de faire bien.
Voici la macro en version 'courte'.
Merci encore à Barbatruc!
Le fil est clos.
Cordialement, JH

Sub MicroLogsShort()
  Dim Lig As Integer, Cellule As Range
  Dim sID As String, eMail As String, number As String, agreement As String
  ' Avec l'objet conteneur - La Feuille : LogsKDI
  With Sheets("LogsKDI")
    For Lig = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      ' Ne pas oublier le point devant range, pour qu'il soit en relation
      ' avec l'objet conteneur, qui est la feuille LogsKDI
      '
      ' Vérifier si l'ID est le même ou pas
      If sID <> "" And .Range("A" & Lig) = sID Then
        ' Si c'est le même on inscrit le mail mémorisé
        .Range("E" & Lig) = eMail
        .Range("F" & Lig) = number
        .Range("G" & Lig) = agreement
      Else
        ' Sinon on récupère l'ID
        sID = .Range("A" & Lig).Value
        ' On cherche l'ID dans l'autre feuille en colonne AB
        Set Cellule = Sheets("NewKDI").Range("AB:AB").Find(What:=sID, LookAt:=xlPart)
        ' Si une cellule est trouvée
        If Not Cellule Is Nothing Then
          ' On mémorise l'email de l'ID pour maintenant et après
          eMail = Sheets("NewKDI").Range("T" & Cellule.Row)
          ' On l'inscrit dans la colonne E
          .Range("E" & Lig) = eMail
        End If
        If Not Cellule Is Nothing Then
          ' On mémorise l'email de l'ID pour maintenant et après
          number = Sheets("NewKDI").Range("W" & Cellule.Row)
          ' On l'inscrit dans la colonne F
          .Range("F" & Lig) = number
        End If
        If Not Cellule Is Nothing Then
          ' On mémorise l'email de l'ID pour maintenant et après
          agreement = Sheets("NewKDI").Range("L" & Cellule.Row)
          ' On l'inscrit dans la colonne E
          .Range("G" & Lig) = agreement
        End If
      End If
    Next Lig
  End With
End Sub