[Macro VBA] Association

[Line_]

Je suis nouvelle sur le forum et j'ai besoin de votre aide .

Voilà, j'ai sur un fichier excel deux feuilles comportant des éléments (dans mon exemple, définis par des lettres (feuille lettre) et des chiffres (feuille chiffre), chaque lettre est associée à un ou plusieurs chiffres (l'association est déjà définie), mon besoin est qu'une macro me permette de récupérer l'ensemble des chiffres (de la feuille chiffre) auxquelles chaque lettre est associée et me la mette dans la feuille lettre (comme les éléments en vert dans exemple).

Merci d'avance pour votre aide

PJ : Exemple.

 

[kjin]

Re : [Macro VBA] Association

Bonsoir et bienvenue,
Avec une fonction perso
A+
kjin

 

[Robert]

Re : [Macro VBA] Association

Bonsoir Line, bonsoir le forum,

En pièce jointe ton fichier modifié avec un bouton et une macro commentée :

Private Sub CommandButton1_Click()
Dim l As Worksheet 'déclare la variable l (onglet Lettres)
Dim c As Worksheet 'déclare la variable c (onglet Chiffres)
Dim pll As Range 'déclare la variable pll (PLage Lettres)
Dim plc As Range 'déclare la variable plc (PLage Chiffres)
Dim cel As Range 'déclare la vaeriable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Premìere Adresse)
 
Set l = Sheets("Lettres") 'définit l'onglet l
Set c = Sheets("Chiffres") 'définit l'onglet c
Set pll = l.Range("A3:A" & l.Range("A65536").End(xlUp).Row) 'définit la plage pll
Set plc = c.Range("B3:B" & c.Range("B65536").End(xlUp).Row) 'définit la plage plc
 
For Each cel In pll 'boucle sur toutes des cellules cel de la plage pll
    Set r = plc.Find(cel.Value, Range("B3"), xlValues, xlWhole) 'définit la variable r
    If Not r Is Nothing Then 'condition 1 : si il existe au moins une occurrence r de cel dans la plage plc
        pa = r.Address 'définit la variable pa
        Do 'éxécute
            If cel.Offset(0, 2).Value = "" Then 'condition 2 : si l'identifiant lettre est vide
                cel.Offset(0, 2).Value = r.Offset(0, -1).Value 'place l'identifiant
            Else 'sinon
                'place l'ancien identifiant, la virgule et le nouvel identifiant
                cel.Offset(0, 2).Value = cel.Offset(0, 2).Value & "," & r.Offset(0, -1).Value
            End If 'fin de la condition 2
            Set r = plc.FindNext(r) 'redéfinit la variable r (prochaine occurrence)
        Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe une nouvelle occurrence r de cel ailleurs qu'en pa
    End If 'fin de la condition 1
Next cel 'prochaine cellule cel de la boucle
End Sub

Édition :

Salut Montpellierrain, on s'est croisé ! Magnifique fonction... Je suis vert !

 

[Compte Supprimé 979]

Re : [Macro VBA] Association

Bonjour Line,

Ci-joint ton fichier avec le code qui va bien 😉😛

Sub AssociationLC()
  Dim Id As String
  ' Variables pour la feuille lettre
  Dim DLig1 As Long, Lig1 As Long
  'Variables pour la feuille Chiffres
  Dim Dlig2 As Long, Lig2 As Long, Sht As Worksheet
  ' Définir la feuille source
  Set Sht = Sheets("Chiffres")
  ' Avec la feuille
  Id = ""
  With Sheets("Lettres")
    DLig1 = .Range("A" & Rows.Count).End(xlUp).Row
    Dlig2 = Sht.Range("A" & Rows.Count).End(xlUp).Row
    For Lig1 = 3 To DLig1
      For Lig2 = 4 To Dlig2
        If .Range("A" & Lig1).Value = Sht.Range("B" & Lig2).Value Then
          Id = Id & Sht.Range("A" & Lig2).Value & ","
        End If
      Next Lig2
      ' Inscription de l'identifiant en enlevant la dernière virgule
      .Range("C" & Lig1).Value = Left(Id, Len(Id) - 1)
      ' Vider la variable Id
      Id = ""
    Next Lig1
  End With
End Sub

A+

Edit : Oups, hello Mister Robert .... pffft ça à l'air compliqué ton truc ...

 

[Line_]

Re : [Macro VBA] Association

Merci ENORMEMENT à vous tous 🙂

J'ai finalement pris la solution de BrunoM45 que j'ai adaptée à mon contexte.

Merci encore.