Transposer informations = Indiquer le groupe en fonction de sa position
Bonjour à tous,
Je vous soumets mon problème que je ne sais pas comment m'y prendre pour le résoudre, voici les explications pour comprendre les détails du problème :
Dans ma feuille " Croisement", j'ai 16 groupes de 3 lignes, les numéros des groupes sont indiqués en la colonne "A", dans notre exemple (ici présent), chaque groupe se compose de 3 lignes mais il peut arriver que le groupe se compose de 4 lignes voir plus.
Je précise aussi que :
La première ligne de chaque groupe représente la position 1, lorsqu’on trouve des sujets qui se trouvent à la position 1, ils seront placés en colonne "L".
La deuxième ligne de chaque groupe représente la position 2, lorsqu’on trouve des sujets qui se trouvent à la position 2, ils seront placés en colonne "M".
La troisième ligne de chaque groupe représente la position 3, lorsqu’on trouve des sujets qui se trouvent à la position 3, ils seront placés en colonne "N".
Pour une plus grande visibilité sur les différents groupes, j'ai coloré chaque groupe d'une couleur différente.
Le travail que je vous demande de faire (En vba s'il vous plaît) consiste à trouver le groupe et la ligne ou se situent tous les sujets de la colonne "K", en les cherchant en colonne "F".
Information : La colonne "K" représente la liste sans doublons des valeurs de la colonne "F" et que j’ai placé en colonne "K" à partir de la ligne 2.
Les résultats qu’on va chercher seront à placer dans le range "L2 :N14"
Pour mieux expliquer la démarche à mettre en œuvre, nous prendrons un exemple, pour cela, on va traiter le premier sujet de la colonne "K" qui se trouve en "K2", il s’agit de : "AE-069/2023 M"
Nous allons chercher les groupes et les lignes (Position) où se trouve la valeur de cette cellule "K2" = "AE-069/2023 M" en colonne "F":
On remarque qu’elle se trouve dans la cellule "F2", qui correspond au Groupe 1 en Position 1 .
Si on continue à chercher cette valeur dans la colonne "F", on la retrouve aussi dans la cellule "F10", qui correspond donc au Groupe 3, position 3.
Maintenant que les informations sont récoltées, On va les placer dans notre range "L2 :N14"
Devant le sujet "AE-069/2023 M" qui se trouve en "K2", on va mentionner en "L1" "Groupe 1" et puis en "N2" on va mentionner "Groupe 3"
Nous allons traiter un 2ème exemple, on va chercher les groupes et les positions du sujet qui se situe dans la cellule "K3", la recherche se fera en colonne "F", il s’agit du sujet : "NM-008/2021 M", les groupes et les positions de ce sujet sont :
F2 = Groupe 1, Position 2, on va mentionner Groupe 1 en Colonne "L"
F7 = Groupe 2, Position 3, on va mentionner Groupe 2 en Colonne "N"
F8 = Groupe 3, Position 1, on va mentionner Groupe 3 en Colonne "L"
F19 = Groupe 6, Position 3, on va mentionner Groupe 6 en Colonne "N"
F31 = Groupe 10, Position 3, on va mentionner Groupe 10 en Colonne "N"
F40 = Groupe 13, Position 3, on va mentionner Groupe 13 en Colonne "N"
On fera de même pour tous les sujets de la colonne "K".
Lorsqu’il y’a plusieurs informations dans les cellules du range "L2 :N14", il seront séparées par un trait-d’unions que j’ai mis en rouge pour séparer les informations entre elles.
Sauf erreur de ma part, vous trouverez la totalité des résultats dans le range "L2 :N14".
J'espère avoir été assez clair dans mes explications, toutefois, je reste à votre disposition pour d'autres informations complémentaires.
Merci pour vos propositions.
Bonjour JFL,
Merci pour votre réponse rapide.
J’ai fait la comparaison de vos résultats aavec ceux que j’ai fournis, ils sont exactement les mêmes, bravo, vous avez bien cerné le problème pour lui apporter une solution car j’avais peur de ne pas bien expliqué ma demande.
Toutefois, j’ai précisé une solution en vba dans un but bien précis pour récupérer la Macro proposée pour l’utiliser dans d’autres feuilles qui demandent la même Macro.
Ça serait sympa de votre part si vous avez le temps pour me proposer une solution en vba, par exemple en utilisant LBound & UBound car ils sont plus rapide.
Au plaisir de vous lire.
Bonjour à tous de nouveau !
Toutefois, j’ai précisé une solution en vba dans un but bien précis pour récupérer la Macro proposée pour l’utiliser dans d’autres feuilles qui demandent la même Macro.
Oups ! Je n'avais pas noté cette contrainte...
Je laisse aux spécialistes VBA le soin de vous concocter une merveilleuse macro.
Bonjour JFL et le forum,
Merci pour votre retour, l’appel aux spécialistes du vba est lancé.
Merci beaucoup et espère une réponse des experts.
Bonsoir à tous,
Dans un premier temps, ton tableau source doit se présenter sous cette forme, pas de lignes vides.
Exécute cette macro, résultat à droite du tableau source.
Option Explicit
Sub transpose()
Dim a, i As Long, AL As Object, dico As Object, e
Application.ScreenUpdating = False
Set AL = CreateObject("System.Collections.ArrayList")
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets("Feuil1").Range("A1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
If Not AL.Contains(a(i, 11)) Then AL.Add a(i, 11)
If Not dico.exists(a(i, 6)) Then
Set dico(a(i, 6)) = CreateObject("Scripting.Dictionary")
End If
dico(a(i, 6))(a(i, 11)) = _
IIf(dico(a(i, 6))(a(i, 11)) = "", a(i, 1), dico(a(i, 6))(a(i, 11)) & " - " & a(i, 1))
Next
AL.Sort
ReDim a(1 To dico.Count + 1, 1 To AL.Count + 1)
For i = 0 To AL.Count - 1
a(1, i + 2) = "Position" & " " & AL(i)
Next
For i = 0 To dico.Count - 1
a(i + 2, 1) = dico.keys()(i)
For Each e In dico.items()(i).keys
a(i + 2, AL.IndexOf(e, 0) + 2) = dico.items()(i)(e)
Next
Next
'Résultat sur la même feuille
With .Offset(, .Columns.Count + 3).Resize(UBound(a, 1), UBound(a, 2))
.CurrentRegion.Clear
.Value = a
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround ColorIndex:=1, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Rows(1).Offset(, 1).Resize(, .Columns.Count - 1).Interior.ColorIndex = 40
.Rows(1).BorderAround ColorIndex:=1, Weight:=xlThin
.Columns(1).Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = 19
.Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Subklin89
Bonjour Klin89,
Merci pour votre retour et le code proposé.
Merci aussi pour le partage de vos connaissances.
J’ai essayé votre code mais malheureusement rien ne se passe et pourtant j’ai rempli les cellules en colonne "A" et "K", selon l’image indiquée .
Pouvez-vous SVP me mettre un lien sur le forum du fichier sur lequel vous avez travaillé.
A vous lire.
Re Harzer,
Je suis sur mon téléphone portable.
Sur ton clavier, en A1 quand tu fais simultanément Ctrl + * , ton tableau source des colonnes A à K est bien pris en compte (CurrentRegion)
Pour le test, tu as supprimé, l'autre tableau au départ.
J'ai repris ton fichier du post #1 et l'ai complété comme sur la photo, j'obtiens le résultat souhaité.
klin89
Bonjour Klin89,
Merci pour votre retour.
Je viens enfin de comprendre pourquoi j’avais dit que rien ne se passe, au fait, les résultats étaient bien là, elles se trouvaient dans les colonnes : "O" - "P" - "Q" et "R".
J’avais élargie fortement mes 3 colonnes "L" - "M" et "N", de ce fait, les résultats n’étaient pas sur mon champs de vision car je ne voyais pas mes colonnes "O" - "P" - "Q" et "R" et d’autant plus, je m’attendais à voir le résultat à partir de la colonne "L".
A ce sujet, et comme je me retrouve avec trois colonnes vides ("L" - "M" et "N"), il serait préférable de commencer les résultats en colonne "L" en lieu et place de la colonne "O".
Qu’en pensez-vous.
NB : J’ai essayé de modifier votre code pour commencer à la colonne "L" mais malheureusement je n’y arrives pas.
A vous lire.
Re Harzer,
Comme ceci :
Option Explicit
Sub transpose()
Dim a, i As Long, AL As Object, dico As Object, e
Application.ScreenUpdating = False
Set AL = CreateObject("System.Collections.ArrayList")
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
'les 11 premières colonnes
With Sheets("Feuil1").Range("A1").CurrentRegion.Resize(, 11)
a = .Value
For i = 2 To UBound(a, 1)
If Not AL.Contains(a(i, 11)) Then AL.Add a(i, 11)
If Not dico.exists(a(i, 6)) Then
Set dico(a(i, 6)) = CreateObject("Scripting.Dictionary")
End If
dico(a(i, 6))(a(i, 11)) = _
IIf(dico(a(i, 6))(a(i, 11)) = "", a(i, 1), dico(a(i, 6))(a(i, 11)) & " - " & a(i, 1))
Next
AL.Sort
ReDim a(1 To dico.Count + 1, 1 To AL.Count + 1)
For i = 0 To AL.Count - 1
a(1, i + 2) = "Position" & " " & AL(i)
Next
For i = 0 To dico.Count - 1
a(i + 2, 1) = dico.keys()(i)
For Each e In dico.items()(i).keys
a(i + 2, AL.IndexOf(e, 0) + 2) = dico.items()(i)(e)
Next
Next
'Résultat sur la même feuille à partir de la colonne L
With .Offset(, .Columns.Count).Resize(UBound(a, 1), UBound(a, 2))
'.Select
.Clear
.Value = a
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround ColorIndex:=1, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Rows(1).Offset(, 1).Resize(, .Columns.Count - 1).Interior.ColorIndex = 40
.Rows(1).BorderAround ColorIndex:=1, Weight:=xlThin
.Columns(1).Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = 19
.Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Subklin89
Bonjour Klin89,
Merci pour votre retour et le code joint, ce dernier fonctionne et me donne le résultat souhaité. C'est Magnifique.
J'ai repris ton fichier du post #1 et l'ai complété comme sur la photo, j'obtiens le résultat souhaité
A ce sujet, au lieu de compléter le fichier manuellement surtout que nous avons travaillé seulement sur une petite partie du fichier. Je me permet de vous demander une toute dernière chose, à savoir, élaborer une boucle qui pourra compléter le fichier automatiquement, je m’explique :
A la colonne "A", on a ajouté ceci manuellement à partir de la ligne 2 jusqu’à la dernière ligne :
Groupe 1
Groupe 1
Groupe 1
Groupe 2
Groupe 2
Groupe 2
Groupe 3
Groupe 3
Groupe 3
…
…
Groupe 16
Groupe 16
Groupe 16
La dernière ligne sera déterminée par la dernière cellule en colonne "F".
Merci encore et au plaisir de vous lire.
Harzer.
Tu veux combler les trous de la colonne A, c'est bien ça ?
Sub remplir()
With Sheets("Feuil1").Range("A2:A" & Cells(Rows.Count, 10).End(xlUp).Row)
'.Select
On Error Resume Next
.SpecialCells(4).FormulaR1C1 = "=r[-1]c"
On Error GoTo 0
.Value = .Value
End With
End Subklin89
Bonjour Klin89,
J’ai testé votre code et j’ai que des zéros, ce n’est pas ce que j’attends.
J’ai joints un fichier avec le résultat souhaité en colonne "A".
Explications : chaque cellule de la colonne "A" contient au début le mot : "Groupe " suivi d’un chiffre, le chiffre se répète sur 3 cellules, dans notre cas, le chiffre commence en 1 et finit en 16.
A vous lire.
Bonjour Klin89 et le Forum,
En ce qui concerne ma dernière demande, j’ai continué à trouver une solution par moi-même malgré que j’ai posté ma demande.
J’ai finalement réussi à trouver une solution basique, le code mis en œuvre n’est certes pas aussi élégant pour les experts comme vous mais il a au moins le mérite de fonctionner.
Merci encore pour votre soutien.
Cordiale poignée de mains.
Voici le code :
Sub Remplir_Colonne_A()
''' Remplir la colonne "A"
Dim dl As Long
Dim x As Long
Dim y As Long
dl = Range("F" & Rows.Count).End(xlUp).Row
'La variable x va successivement prendre les valeurs 2 à dernière ligne
Cells(1, 1).Value = "Groupes"
y = 1
For x = 2 To dl
'on identifie les cellules qui vont prendre la variable
Cells(x, 1) = "Groupe " & y
Cells(x + 1, 1) = "Groupe " & y
Cells(x + 2, 1) = "Groupe " & y
x = x + 2
y = y + 1
Next x
End SubBonjour à tous,
Harzer, on peut aussi l'obtenir par formule, la ligne 1 restant la ligne d'en-têtes.
A2 = 1, en A3
=SI(MOD(LIGNE()-2;3)=0;A2+1;A2)
klin89
Bonjour Klin89 et le forum,
Merci pour votre retour, en effet, la formule fonctionne très bien, C’est Magic.
Merci encore et au plaisir de discuter à l’occasion pour une nouvelle demande, qui sait !
Amicalement.
Harzer.
Re
Ou plutôt ceci pour remplir la colonne A à partir de A3 à recopier vers le bas.
A2 = Groupe 1
=SI(MOD(LIGNE()-2;3)=0;"Groupe "&DROITE(A2;NBCAR(A2)-TROUVE(" ";A2))+1;"Groupe "&DROITE(A2;NBCAR(A2)-TROUVE(" ";A2)))
klin89
Bonjour Klin89 et le forum,
Merci pour votre retour, j’ai testé la formule, elle fonctionne très bien et me satisfait totalement.
Cordiale poignée de mains.
Amicalement.