Répartition de noms suivant critéres

[GHISLAIN]

Bonjour le forum ,
voila je cherche à répartir des noms présents dans une feuille classés par catégorie et les répartir automatiquement sur la feuille répartition .
Exemple un "tableau" appelé PL1 , dans ce tableau plusieurs colonnes ( A B C D E F ). Sous chaque colonne des noms , toto1 , 2 , 3 etc
Le but est de récupérer ces noms et les rapatrier dans la feuille répartition , suivant la ligne et lettre correspondante .
Quand la liste de nom est épuisée ,reprendre au début et continuer la boucle sur les 365 366 jours de l'année

Voili voilou

J’espère avoir donné le plus d'information possible a mon projet

Ci joint un petit fichier exemple

Merci a tous de vos propositions et solutions

Bien amicalement

Ghislain

 

[Hieu]

Salut,

Une idée :

 

[GHISLAIN]

Bonjour Hieu,
Merci d’être passé sur mon fil .

la proposition fonctionne presque , elle extrait les noms présents dans la liste .
mais n'effectue pas de répétion. Effectivement , exemple :
Si en A j'ai toto1 , toto2 , toto3 dans la feuille de noms
La formule répercute bien les noms présents , mais s'arrete si il y a plus de noms et moi je souhaiterais lorsque les trois toto sont utilisés que la boucle recommence et reprenne toto1 , toto2 , toto3 sur autant de A rencontré

donc
Premier A toto1
second A toto2
troisième A toto3
La liste de noms est terminée, donc reprendre au début :
quatrième A re toto1
cinquième A re toto2
sixième A re toto 3
La liste de noms est terminée, donc reprendre au début :
septième A re toto1
huitième A re toto2
neuvième A re toto 3
etc etc
jusqu’à la fin de tous les A rencontrés de la feuille recuperation

Merci a toi

 

[Hieu]

Un fichier exemple de ce que tu souhaites en sortie vaut mieux qu'un long discours

 

[GHISLAIN]

le fichier a été joint lol

 

[GHISLAIN]

un peu plus de clarté peut être

 

[GHISLAIN]

bonjour le forum,

j'avance a taton ....
ci joint une macro mais le souci elle remplit mes cellules et les efface...

je vois pas mon erreur

merci a vous

cdt

Ghislain

 

[M12]

Bonjour,

Pour ton avancement à taton
Teste ceci

Sub mavaleur()
Dim plage As Range
Set plage = ThisWorkbook.Worksheets("Feuil1").Range("B1:K1")
Monchiffre = "A" 'adefinir suivant la recherche
j = 2
  For i = 2 To 20
    For Each Cell In plage
      If Cell.Value = Monchiffre Then
        Cell(j, 1) = Range("a" & i)
      End If
      If Cell.Column = 11 Then j = j + 1
    Next Cell
  Next i
End Sub

 

[GHISLAIN]

bonjour M12,
merci pour ton concours sur ce post et de ta solution , je pense m’être mal expliqué au vu de la proposition.
Ci joint le fichiers plus compréhensible , enfin je l’espère

bien amicalement

Ghislain

 

[M12]

Re,

Donc, si j'ai compris

 

[GHISLAIN]

re,

presque ça , ma plage de nom est variable , je peux avoir 1 jusqu’à 20 noms différents ...
Du coup si j’enlève un nom sur la proposition cela me donne une case vide et si je rajoute des noms ceux si ne sont pas pris en compte .....
merci pour ta patience et disponibilité

Amicalement

 

[GHISLAIN]

re ,

du coup sur ta proposition je rajoute un variable qui me compte le nombre de cellule non vide
es ce que ca parait une bonne solution ?

nbcells = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))
MsgBox nbcells




For i = 2 To 20
For Each Cell In plage
If Cell.Value = Monchiffre Then
Cell(2, 1) = Range("a" & i)
i = i + 1
If i = nbcells Then i = 2
End If
If Cell.Column = 26 Then Exit Sub
Next Cell
Next i
End Sub

 

[M12]

Re,
Dans ce cas comme ceci, pas de limitation en ligne et colonne

Sub mavaleur()
Dim plage As Range
Set plage = ThisWorkbook.Worksheets("Feuil1").Range("B1:zZ1")
Monchiffre = "A" 'adefinir suivant la recherche
j = Cells(1, Application.Columns.Count).End(xlToLeft).Column 'dernière colonne non vide
nbcells = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A")) + 2
  For i = 2 To 20
    For Each Cell In plage
      If Cell.Value = Monchiffre Then
        Cell(2, 1) = Range("a" & i)
        i = i + 1
        If i = nbcells Then i = 2
      End If
      If Cell.Column = j Then Exit Sub
    Next Cell
  Next i
End Sub

 

[Hieu]

Salut tout le monde,

En créant une petite fonction personnalisée, pour déterminer la ligne du tableau :

Function lig(nb)
temp = nb Mod 30
If nb = 30 Then temp = 30
Select Case temp
    Case 1 To 5: lig = 1
    Case 6 To 10: lig = 2
    Case 11 To 15: lig = 3
    Case 16 To 20: lig = 4
    Case 21 To 25: lig = 5
    Case 26 To 30: lig = 6
End Select
End Function

 

[GHISLAIN]

re , bonjour Hieu,

merci a vous d'avoir prit le temps de solutionner ce post !! rien a dire des cadors en la matière

juste pour conclure dans le cas ou je prends mes noms dans une autre feuille j'ai opté pour le code , enfin quelques modifications suivantes :



Dim plage As Range
Set plage = ThisWorkbook.Worksheets("Affection").Range("B1:zZ1")
Monchiffre = "A" 'adefinir suivant la recherche
j = Cells(1, Application.Columns.Count).End(xlToLeft).Column 'dernière colonne non vide
nbcells = Application.WorksheetFunction.CountA(Feuil2.Range("$A:$A")) + 1

For i = 2 To 20
For Each Cell In plage
If Cell.Value = Monchiffre Then
Cell(2, 1) = ThisWorkbook.Worksheets("RépartionAgents").Range("a" & i)
i = i + 1
If i = nbcells Then i = 2
End If
If Cell.Column = j Then Exit Sub
Next Cell
Next i



merci sincèrement a vous

Bien amicalement

Ghislain