Affectation via Index Equiv

jipi06

XLDnaute Junior
Bonjour

je souhaite transformer un fichier que je viens de récupérer via un sondage proposant à un groupe de personne de s'inscrire à un chantier avec des rôles différents soit Pilote soit Collaborateur. Le nom des personnes en Col A, les chantiers en Ligne 1 et la distribution des rôles dans les cellules...
Je voudrais afficher ce tableau différemment, avec le Rôle en col A ; les chantiers en ligne 1 et le nom des contributeurs/pilote dans les cellules.
Je n'y arrive pas avec Index Equiv ou je m'y prends mal.

Un fichier exemple résume ma demande

Merci de votre aide

jipi06
 

Pièces jointes

  • Affectation.xlsx
    38.5 KB · Affichages: 11

vgendron

XLDnaute Barbatruc
Bonsoir
une idée avec une formule matricielle
en H2:
=SIERREUR(INDEX($A$2:$A$19;PETITE.VALEUR(SI(B$2:B$19=$G2;LIGNE(B$2:B$19);"");NB.SI($G$2:G2;G2))-1);"")
valider par Ctrl+Maj+Entrée
tirer vers la droite et vers le bas

avec celle ci plutot
VB:
=SIERREUR(INDEX($A$2:$A$19;PETITE.VALEUR(SI(B$2:B$19=$G2;LIGNE(B$2:B$19);"");NB.SI($G$2:$G2;$G2))-1);"")
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @jipi06, @vgendron ;),

Un autre essai par macro. Le code se trouve dans le module de code de la feuille "Affectation". Cliquez sur le bouton Hop!.
VB:
Sub Transposer()
Dim t, i&, j&, m&, ok As Boolean, ntot&
  t = Range("a1").CurrentRegion.Value
  ReDim res(1 To 4 * UBound(t), 1 To UBound(t))
  ntot = 1
  res(ntot, 1) = "Rôle"
  For j = 2 To UBound(t, 2): res(ntot, j) = t(1, j): Next j
  For i = 2 To UBound(t)
    For j = 2 To UBound(t, 2)
      If t(i, j) <> "" Then
        ok = False
        t(i, j) = UCase(t(i, j))
        For m = 2 To ntot
          If res(m, 1) = t(i, j) Then
            If res(m, j) = "" Then
              res(m, j) = t(i, 1)
              ok = True
              Exit For
            End If
          End If
        Next m
        If Not ok Then
          ntot = ntot + 1
          res(ntot, 1) = t(i, j)
          res(ntot, j) = t(i, 1)
        End If
      End If
    Next j
  Next i

  Range("g1").CurrentRegion.Clear
  Range("g1").Resize(UBound(res), ntot) = res
  With Range("g1").CurrentRegion
    .Borders.LineStyle = xlContinuous
    .Sort key1:=Range("g1"), order1:=xlAscending, Header:=xlYes
    .Columns(1).Interior.Color = RGB(200, 200, 200)
    .Columns(1).Font.Color = RGB(50, 50, 250)
    .Columns(1).Font.Bold = True
    .Rows(1).Interior.Color = RGB(200, 200, 200)
    .Rows(1).Font.Bold = True
  End With
End Sub
 

Pièces jointes

  • jipi06- Transposer- v1.xlsm
    20.3 KB · Affichages: 11

Statistiques des forums

Discussions
311 719
Messages
2 081 881
Membres
101 829
dernier inscrit
listener75