Corrélation de cases dans un tableau avec des données partielles
Bonjour,
j'ai un tableau dans ma feuille "données à tester", avec en entête ligne 1 : "Prénom / Nom / Age" de personnes, dans ce tableau j'ai des données sur ces personnes mais elle sont pas forcément toutes les trois sur une seule ligne, par exemple pour Alain, j'ai les trois information en deux lignes comparé à Vincent où je les ai en une seule ligne. A chaque fois mes données sont unique donc j'ai qu'une seule personne qui peut avoir 14 ans, qu'une seule personne qui a le prénom Alain et qu'une seule personne qui a le nom Parfait donc je peux " " " facilement les corréler " " ", il me faut juste associer les données.
J'aimerais que ma macro :
- vérifie si ce n'est pas Kelly Diossi 10 (ça j'y arrive) ;
- Si ce n'est pas Kelly Diossi 10, qu'elle vérifie si les données sont présentes dans l'onglet "données uniques", si les données (sauf les données NULL) ne sont pas présentes elle les ajoute dans le tableau en créant une nouvelle ligne, si une partie des données sont connues alors elle ajoute sur la même ligne les données qui manque. Par exemple, avec les lignes qui correspondent à Alain, je n'ai jamais toutes mes données sur une ligne, la macro cherche si Alain est dans "données unique", il n'y est pas donc elle ajouter "Alain" dans la colonne prénom dans la feuille "données uniques". Puis deux ligne après elle voit Alain avec une nouvelle information, son NOM qui est "Parfait", la macro ajoute le nom d'Alain sur la même ligne qu'Alain. Pour finir, à la dernière ligne, il n'y a pas Alain mais la macro connait Parfait donc elle ajoute 11 à la ligne qui contient Parfait. je me retrouve donc avec une ligne Alain / Parfait / 11
Voici la première partie du code qui marche, les MsgBox c'est juste pour tester :
Public Sub test()
Dim varValeur As Variant
i = 1
Ligne = 1
TROUVE = False
For i = 2 To 16 ' Un for incrémente tout seul sa variable
varValeur = Switch(Cells(i, 1) = "Kelly", True, Cells(i, 2) = "Diossi", True, Cells(i, 3) = 10, True) ' Vérifie s'il y a la présence de Kelly Diossi
If IsNull(varValeur) Then
' Il y a pas Kelly Diossi
MsgBox "il n'y a pas Kelly Diossi"
Else
' Il y a Kelly Diossi
MsgBox "il y a Kelly Diossi"
End If
Next i
End SubVoici la feuille "données à tester" :
| Prénom | NOM | Age |
| Kelly | Diossi | 10 |
| Vincent | ||
| Diossi | 10 | |
| Vincent | Time | 12 |
| ALAIN | ||
| Line | ||
| ALAIN | Parfait | |
| Kelly | Diossi | |
| LUQUI | Luc | |
| Line | 14 | |
| Vincent | Time | 12 |
| Evitable | 14 | |
| Luc | 13 | |
| Parfait | 11 |
Voici la feuille "données unique" :
| Prénom | NOM | Age |
voici à quoi doit ressembler le résultat final :
Merci par avance pour vos réponses, je sais c'est un peu difficile à comprendre mais ça me faciliterait beaucoup la vie :)
bonjour,
je pense que c'est ceci que vous demandez, la macro colle les données 4 colonnes à droite de l'original.
Sub Copier_Coller()
Set c = Range("A2:C16") 'vos données
Set c1 = c.Offset(, 4) 'plage 4 colonnes à droite
c1.ClearContents 'vider cette plage
ptr = 0 'compteur
For i = 1 To c.Rows.Count 'boucle les lignes
If Len(c(i, 1)) > 0 Then 'colonne A n'est pas vide
r = Application.Match(c(i, 1), c1.Columns(1), 0) 'recherche nom dans colonne 1 de la 2ième plage
If Not IsNumeric(r) Then 'pas trouvé
ptr = ptr + 1 'augmenter compteur
r = ptr 'numéro de la ligne
c1(r, 1) = c(i, 1) 'copier&coller le nom
End If
For j = 2 To 3 'les autres colonnes
If Len(c(i, j)) > 0 Then c1(r, j) = c(i, j) 's'elles ne sont pas vide, copier&coller
Next
End If
Next
End Subbonjour,
c'est difficile à dire sans fichier. Faut-il changer la plage de c ?
bonjour,
c'est plus facile à trouver l"erreur comme ça
Sub Copier_Coller()
Set c = Range("A2:C16") 'vos données
Set c1 = c.Offset(, 4) 'plage 4 colonnes à droite
c1.ClearContents 'vider cette plage
ptr = 0 'compteur
For i = 1 To c.Rows.Count 'boucle les lignes
If i = 13 Then MsgBox "1"
If Len(c(i, 1)) > 0 Then 'colonne A n'est pas vide
r = Application.Match(c(i, 1), c1.Columns(1), 0) 'recherche nom dans colonne 1 de la 2ième plage
If Not IsNumeric(r) Then 'pas trouvé
ptr = ptr + 1 'augmenter compteur
r = ptr 'numéro de la ligne
c1(r, 1) = c(i, 1) 'copier&coller le nom
End If
For j = 2 To 3 'les autres colonnes
If Len(c(i, j)) > 0 Then c1(r, j) = c(i, j) 's'elles ne sont pas vide, copier&coller
Next
Else
If Len(c(i, 2)) > 0 Then 'colonne B n'est pas vide
r = Application.Match(c(i, 2), c1.Columns(2), 0) 'recherche nom dans colonne 2 de la 2ième plage
If IsNumeric(r) Then
c1(r, 3) = c(i, 3) 's'elles ne sont pas vide, copier&coller
ElseIf Len(c(i, 3)) > 0 Then 'colonne C n'est pas vide
r = Application.Match(c(i, 3), c1.Columns(3), 0) 'recherche nom dans colonne 3 de la 2ième plage
If IsNumeric(r) Then c1(r, 2) = c(i, 2) 's'elles ne sont pas vide, copier&coller
End If
End If
End If
Next
End SubDéso pour la réponse tardive je regardais ton code et je galère un peu a comprendre comment tu fais fais ça marche alors merci beaucoup. Sauf que j'ai oublié de rajouter une personne un peu relou où enfaite j'ai d'abord son nom âge puis sont prénom âge et la la macro ne marche pas, tu peux ajouter ce cas relou stp ?
ça me parait bizzard que ça ne marche pas car tu vérifies si la case prénom n'est pas vide pour vérifier avec le nom mais je pense qu'il doit manquer une étape du style : Si case prénom = vide alors copie colle les cases nom et âge dans la plage résultat.
merci pour les commentaires c'est sympas.
bonjour dimitri,
Sub Dimitri()
Dim Out
a = Range("A1:C100").Value 'lire la plage vers une matrice
ReDim Out(1 To UBound(a), 1 To 3) 'dimensioner 2ième matrice avec meme grandeur
For i = 1 To UBound(a) 'boucle le lignes
If Len(a(i, 1) & a(i, 2) & a(i, 3)) > 0 Then 'tous les éléments ne sont pas vide
For j = 1 To UBound(a, 2) 'boucle les colonnes
If Len(a(i, j)) > 0 Then 'cette colonne n'est pas vide
r = Application.Match(a(i, j), Application.Index(Out, 0, j), 0) 'recherche-le dans la même colonne de OUT
If IsNumeric(r) Then 'trouvé ?
For k = 1 To 3 'boucle les 3 colonnes
If Out(r, k) = "" Then Out(r, k) = a(i, k) 'ajouter les éléments s'ils sont vide
Next
Exit For 'sortir du 2ième boucle
End If
End If
Next
If Not IsNumeric(r) Then 'rien trouvé dans aucun des 3 colonnes
ptr = ptr + 1 'compteur des lignes
For k = 1 To 3 'boucle les 3 colonnes
Out(ptr, k) = a(i, k) 'ajouter les éléments
Next
End If
End If
Next
Range("D1").Resize(UBound(Out), UBound(Out, 2)).Value = Out 'écrire nouvelles données
End SubBonjour BsAlv,
merci pour tes réponses qui me semblent bien matinale. Quand je donne toutes les info forcément ça marche mieux xD
Merci beaucoup ça marche à la perfection.
Merci encore pour tes commentaires j'arrive mieux à comprendre.
Bonne soirée à toi :)
