Microsoft 365 Besoin d'aide pour créer une formule

[Aphrodyte]

Bonjour à tous,
Autant j'arrive sans trop de problèmes à créer des formules mathématiques, autant là je n'arrive à rien avec la formule dont j'ai besoin !!!
Je m'adresse donc aux experts des formules "logiques".
Je vais résumer le plus simplement possible, et je vous mets un petit tableau ci-joint en exemple pour expliquer ce dont j'ai besoin.
Ce tableau comporte 3 colonnes:
Colonne A = Tél mobile
Colonne B = Utilisateur
Colonne C = Mot de passe
Je voudrais que pour toutes les lignes comportant le même nom (par exemple Alain DUPONT en ligne 2), son Tél mobile et son mot de passe en ligne 2 se reporte dans les autres lignes du même nom (lignes 6 et 12 dans mon tableau-exemple).
Mais seulement si la ligne de destination est d'une certaine couleur (JAUNE dans mon tableau-exemple). Les lignes avec le même nom mais sans couleur ne doivent pas être remplies.
Voilà, ça va sûrement sembler simplissime à beaucoup d'entre vous, mais moi j'abandonne !!! Je craque......
Merci d'avance du fond du coeur à ceux qui accepteront de se pencher sur mon problème.
Bonne soirée à tous,
Nathalie

 

[job75]

Bonjour Aphrodyte, bienvenue sur XLD,

Voyez le fichier joint et cette macro affectée au bouton :

Sub MAJ()
Dim c As Range
For Each c In Sheets("Feuil1").UsedRange.Columns(2).Cells
    If c.Interior.ColorIndex = 6 Then
        c(1, 0) = "=INDEX(C,MATCH(RC[1],C[1],0))"
        c(1, 2) = "=VLOOKUP(RC[-1],C[-1]:C,2,0)"
    End If
Next
End Sub

A+

 

[Aphrodyte]

Bonjour job75,
Je viens de tester votre macro et ça fonctionne nickel. Merci infiniment, je n'y serais jamais arrivée (je n'y connais absolument rien en macros !).
Je vais maintenant essayer de l'appliquer à mon énorme fichier réel.
Encore merci à vous,
Nathalie.

 

[Aphrodyte]

Re-bonjour job75,
Je suis en train de tester la macro sur mon fichier réel.
Je me rends compte que j'aurais dû joindre un fichier correspondant exactement au mien, et que j'ai oublié une condition essentielle.
Je joins donc le fichier que vous m'avez envoyé avec la macro et le bouton. Mais il est maintenant modifié comme le mien, et du coup ça ne fonctionne pas.

Je vous re-précise les conditions dont j'ai besoin:

- Pour les lignes comportant le même nom en colonne D (par exemple "DUPONT, Alain" en ligne 5), le Tél mobile (colonne C) et le commentaire (colonne F) se reportent dans les autres lignes ayant le même nom d'utilisateur.

- Mais le report ne doit se faire QUE pour les lignes blanches, et seulement vers les lignes vertes.
(Les lignes vertes ne doivent pas jamais se reporter nulle part, et les lignes blanches ne doivent pas se reporter vers d'autres lignes blanches).

- Il faut également que le report ne concerne QUE les noms (colonne D) ayant une virgule dans leur nom (car il y a aussi des services (sans virgule) dans cette colonne, et il ne faut surtout pas reporter les données des services).

- et dernière condition, il ne faut pas que les colonnes C et F se reportent si elles sont vides.

Je me rends compte que finalement, c'est plus compliqué que prévu, et je ne voudrais pas vous ennuyer avec ça. J'ai essayé de modifier la macro moi-même, mais je suis vraiment nullissime en macros !!!

Est-ce possible pour vous ou est-ce trop compliqué ?

Merci d'avance pour votre réponse.

A+

 

[job75]

Cela n'a plus rien à voir avec le problème posé au post #1 :

Sub MAJ()
Dim d As Object, tablo, couleur&(), i&, coul&, y$, x$, s
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Sheets("Feuil1").UsedRange.Columns(3).Resize(, 4) 'colonnes C à F
    tablo = .Value 'matrice, plus rapide
    ReDim couleur(1 To UBound(tablo))
    '---liste sans doublon---
    For i = 2 To UBound(tablo)
        couleur(i) = .Cells(i, 2).Interior.ColorIndex
        coul = couleur(i)
        If coul = xlNone Or coul = 2 Then
            y = tablo(i, 1) & Chr(1) & tablo(i, 4)
            If y <> Chr(1) Then
                x = Replace(tablo(i, 2), " ", "") 'supprime les espaces
                If InStr(x, ",") Then d(x) = y
            End If
        End If
    Next i
    '---remplissage des cellules colorées quand c'est possible---
    For i = 2 To UBound(tablo)
        coul = couleur(i)
        If coul <> xlNone And coul <> 2 Then
            x = Replace(tablo(i, 2), " ", "")
            If d.exists(x) Then
                s = Split(d(x), Chr(1))
                tablo(i, 1) = s(0)
                tablo(i, 4) = s(1)
            End If
        End If
    Next i
    '---restitution---
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Value = tablo
End With
End Sub

 

[job75]

Pour tester j'ai copié le tableau A2:G17 sur 16 000 lignes.

La macro s'exécute chez moi en 0,35 seconde.

 

[Aphrodyte]

Je viens de tester aussi sur mon "vrai" tableau" de 8000 lignes : c'est nickel !
Mille mercis pour ton aide, c'est génial et vraiment très très sympa !
Il me restera juste un petit problème mais ça on n'y peut rien : je serai obligée à chaque fois de naviguer entre Excel chez moi (pour lancer la macro) et LibreOffice au boulot (Excel est interdit sur les ordis au boulot !!!).
Je viens de tester la macro sous LibreOffice, et elle ne fonctionne pas malheureusement.
Mais je ne me faisais pas beaucoup d'illusions à ce sujet...
Encore merci pour tout, et très bon week-end.
A+