Support excel tableau croisé

Bonjour,
Merci de me support par un macro ou une méthode d'utiliser tableau croisé afin que les X doivent remplacés par leurs valeur en haut (exemple X==>2GA_970_064).

https://www.cjoint.com/c/FGpnFk6Auxj

Merci par votre rapide support svp

8 réponses

  1. bjr,
    merci bcp pour le support ça marche très bien jusqu’à l'instant,
    juste une seule question est ce qu'il faut tjrs copier et coller le code vba?
    merci
    Crd
    0
    1. Vous n'avez pas copier dans un module le code fournit précédemment
      Sur la feuille EXCEL, appuyez simultanément sur les touches: ALT et F11, (ça ouvre la page VBA)
      Clic sur "Insertion" , sélectionnez "Module"
      Copiez le code suivant
      Sub RemplacerXparValeurs()
          Application.ScreenUpdating = False
          Set f1 = Sheets("Alle Familien")
          Set f2 = Sheets("Demande")
          f2.Cells.Clear 'on efface le contenu de la feuille "Demande"
          DerCol = f1.[XFD2].End(xlToLeft).Column
          DerLig = f1.[B1000000].End(xlUp).Row
          For Each Cell In Range(f1.Cells(3, 2), f1.Cells(DerLig, DerCol))
              If Cell.Column = 2 Then
                  f2.Cells(Cell.Row + 7, 2).Value = Cell.Value
              ElseIf Cell.Value = "X" Then
                  f2.Cells(Cell.Row + 7, f2.Cells(Cell.Row + 7, 16000).End(xlToLeft).Column + 1).Value = f1.Cells(2, Cell.Column).Value
              End If
          Next Cell
          
          'Mise en forme
          f2.Select
          [B9] = "Wires"
          Range(Cells(9, 3), Cells(9, Cells.Find("*", , , , xlByColumns, xlPrevious).Column)) = "Module"
          Columns("B:B").Select
          With Selection 'centrage des éléments de la colonne "B"
              .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlCenter
          End With
          With Selection.Font 'on applique la police "GRAS" aux têtes de lignes
              .Bold = True
              .Color = -11489280 'couleur verte
          End With
          Rows("9:9").Font.Bold = True 'on applique la police "GRAS" aux têtes de colonnes
          Range(Cells(9, 2), Cells(DerLig + 7, DerCol)).Borders().LineStyle = xlContinuous 'on refait le quadrillage du tableau
          Range(Cells(5, 3), Cells(DerLig, DerCol)).EntireColumn.AutoFit 'Ajustement des colonnes
          [G4].Select
      End Sub
      

      et collez dans le module
      Essayez
      0
      1. Bonjour.
        Merci pour l'effort. le fichier xlsx est ouvert mais quand je clique sur importation des modules je reçois un msg (impossible d'exécuter la macro "...".il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivees).
        Merci d'avance
        Crd
        0
        1. Bonjour
          Autre proposition, j'ai enregistré le fichier au format xlsb
          https://www.cjoint.com/c/FGsbmypQhBw
          Come le format xlsm, enregistrez le avant de l'ouvrir.
          Si ça ne fonctionne toujours pas, voici le fichier au format xlsx
          https://www.cjoint.com/c/FGsbpD2Cymw
          Il n'y a plus qu'à recopier ce bout de code dans un module
          Sub RemplacerXparValeurs()
              Application.ScreenUpdating = False
              Set f1 = Sheets("Alle Familien")
              Set f2 = Sheets("Demande")
              f2.Cells.Clear 'on efface le contenu de la feuille "Demande"
              DerCol = f1.[XFD2].End(xlToLeft).Column
              DerLig = f1.[B1000000].End(xlUp).Row
              For Each Cell In Range(f1.Cells(3, 2), f1.Cells(DerLig, DerCol))
                  If Cell.Column = 2 Then
                      f2.Cells(Cell.Row + 7, 2).Value = Cell.Value
                  ElseIf Cell.Value = "X" Then
                      f2.Cells(Cell.Row + 7, f2.Cells(Cell.Row + 7, 16000).End(xlToLeft).Column + 1).Value = f1.Cells(2, Cell.Column).Value
                  End If
              Next Cell
              
              'Mise en forme
              f2.Select
              [B9] = "Wires"
              Range(Cells(9, 3), Cells(9, Cells.Find("*", , , , xlByColumns, xlPrevious).Column)) = "Module"
              Columns("B:B").Select
              With Selection 'centrage des éléments de la colonne "B"
                  .HorizontalAlignment = xlCenter
                  .VerticalAlignment = xlCenter
              End With
              With Selection.Font 'on applique la police "GRAS" aux têtes de lignes
                  .Bold = True
                  .Color = -11489280 'couleur verte
              End With
              Rows("9:9").Font.Bold = True 'on applique la police "GRAS" aux têtes de colonnes
              Range(Cells(9, 2), Cells(DerLig + 7, DerCol)).Borders().LineStyle = xlContinuous 'on refait le quadrillage du tableau
              Range(Cells(5, 3), Cells(DerLig, DerCol)).EntireColumn.AutoFit 'Ajustement des colonnes
              [G4].Select
          End Sub

          Essayez
          Cdlt
          0
          1. bjr.
            jai enregistrer le fichier dans mn bureau,et lors de louverture de fichier,ça marche pas.je reçois l msg impossible.
            merci jessayer
            0
            1. bjr
              est ce que tu peux enregistrer le fichier sous format 2010 xlsx.
              0
          2. Bonjour
            Cliquez sur le bouton dans la feuille "Demande"
            https://www.cjoint.com/c/FGre5oCy80w
            Cdlt
            0
            1. Bonjour.
              Quand j'essaye d'ouvrir le fichier je reçois un msg (impossible d'ouvrir le fichier. ..car son format ou son extension n'est pas valide.vérifier que le fichier n'est pas endommagé et que son extension correspond bien au format du fichier )
              Merci pour le support
              Crd
              0
            2. Bonjour
              N'essayez pas d'ouvrir le fichier directement à partir du lien, sélectionnez plutôt l'option "Enregistrer la cible du lien sous" et choisissez le répertoire de destination.
              A partir de là, il s'ouvre très bien.
              Cdlt
              0
          3. Bonjour,
            merci d'abord pr tn support.
            le fichier ça marche,
            est ce que appliquer ce code pr ce fichier
            https://www.cjoint.com/c/FGquB1wrFyr
            je souhaite tjr avoir les résultats dans la feuil demande (les info existent dans la feuil Alle famillen
            n.b ; la colonnes B ET LA LINNE 2 DOIVENT ETRE ILIMITEs
            PAR CE QUE JE VX UTILISER CE FICHIER TJR DANS MON TRAVAIL IL CE PEUT QUE JAURAIS PLUS DES REF DES WIRES ET DES REF 2GA.......
            CRD
            merci
            0