Recherche de valeurs dans plusieurs colonnes
Qoods
-
Qoods -
Qoods -
Bonjour à tous,
Je voudrais gagner un temps fou en recherche et j'ai besoin de vous.
J'ai 34 colonnes dont leur contenu est un ensemble de champs mais tous les champs ne sont pas forcément présents dans chaque colonne.
Admettons les champs suivants : 1, 2, 3, 4, 5, 6, 7
Admettons les colonnes avec les noms suivants : A, B, C, D
(Je mets des points pour combler les vides)
Exemple :
A B C D
---------
1 3 1 3
2 2 5 5
3 .. 7
4
5
Je voudrais savoir s'il était possible de transposer l'affichage de façon à avoir les champs qui passent en tête de colonne et les noms des colonnes qui passent en valeurs ?
Exemple :
1 2 3 4 5 6 7
---------------
A A A A A . C
C B B .. C .
.. .. D . D .
Merci d'avance
Je voudrais gagner un temps fou en recherche et j'ai besoin de vous.
J'ai 34 colonnes dont leur contenu est un ensemble de champs mais tous les champs ne sont pas forcément présents dans chaque colonne.
Admettons les champs suivants : 1, 2, 3, 4, 5, 6, 7
Admettons les colonnes avec les noms suivants : A, B, C, D
(Je mets des points pour combler les vides)
Exemple :
A B C D
---------
1 3 1 3
2 2 5 5
3 .. 7
4
5
Je voudrais savoir s'il était possible de transposer l'affichage de façon à avoir les champs qui passent en tête de colonne et les noms des colonnes qui passent en valeurs ?
Exemple :
1 2 3 4 5 6 7
---------------
A A A A A . C
C B B .. C .
.. .. D . D .
Merci d'avance
1 réponse
-
Bonsoir,
Je pense que ce code VBA devrait répondre au problème (avec ce code, il faut ajouter la référence Microsoft scripting runtime)
' Ajouter la référence Microsoft scripting runtime
Sub transposer_noms()
Dim champs As New Dictionary
Dim champ As Object
Dim début_champs, plage, plage_noms, plage_champs As Range
Dim i, c As Integer
Dim clé As Variant
Dim noms() As String
Set début_champs = [A1]
Set plage_utilisée = ActiveSheet.UsedRange
Set plage_noms = plage_utilisée.Rows(1) 'noms : en ligne 1 '
Set plage_champs = plage_utilisée.Offset(1).Resize(plage_utilisée.Rows.Count - 1) 'champs : des lignes 2 à la dernière utilisée
'ajout des champs en clé avec pour chaque clé le tableau des noms associés
i = 0
For Each champ In plage_champs.Cells
If Not IsEmpty(champ.Value) Then
If Not champs.Exists(champ.Value) Then
ReDim noms(1)
noms(0) = plage_noms.Columns(champ.Column).Value
champs.Add Key:=champ.Value, Item:=noms
Else
noms = champs(champ.Value)
i = UBound(noms)
ReDim Preserve noms(i + 1)
noms(i) = plage_noms.Columns(champ.Column)
champs(champ.Value) = noms
End If
End If
Next
If champs.Count > 0 Then
'initialisation de la nouvelle plage des champs
plage_utilisée.Clear
' remplissage champs de la feuille active à partir de la variable range "début_champs"
début_champs.Resize(, champs.Count).Value = champs.Keys
c = 0
For Each clé In champs.Keys
noms = champs(clé)
début_champs.Offset(1, c).Resize(UBound(noms)).Value = Application.Transpose(noms)
c = c + 1
Next
End If
End Sub
