Discussion :

[Kaptain84]

Bonjour,

Je m'adresse à vous car je fais face à un problème.
Vous trouverez en PJ une illustration de mon besoin.

J'ai initialement un tableau qui répertorie différentes erreurs ainsi que leurs quantités en ligne pour un matricule donné (clé unique).

Je souhaiterai le transposer de manière à avoir ceci en colonne de manière à obtenir dans une première colonne mon identifiant unique, et en 2ème colonne l'intitulé des erreurs (répétés si plusieurs erreurs) sur des ligne distinctes. Ceci afin de pouvoir mettre dans une 3ème colonne un commentaire concernant l'erreur remontée pour une matricule particulier.

Je ne sais pas si j'ai été très clair, mais j'espère que l'illustration aidera grandement à la compréhension.

Ma question est donc la suivant:
est-ce envisageable de faire ça sous ecxel, et si oui (on me dira que tt est possible avec VBA) comment ? en effet je ne connait rien en VBA, et les bout de codes que j'ai trouvé dans ce forum ne m'ont pas vraiment aidé.

Merci d'avance de votre compréhension et de votre attention.

[zyhack]

Bonjour

je suis parti sur le principe que le
premier tableau est dans Feuil1, et les données à partir de la ligne 2

et le deuxième tableau dans Feuil2 Ecriture à partir de A2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Sub arrangement()
Dim wsh As Worksheet, B As Integer
Dim C As Range, D As Range, ligne As Long
Set wsh = Worksheets("Feuil2")
ligne = 2
With Worksheets("Feuil1")
'boucle dans les lignes
For Each C In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
  If C <> "" Then 'en cas de ligne vide
    'boucle dans les colonnes
    For Each D In .Range(.Cells(C.Row, 3), .Cells(C.Row, .Cells(C.Row, Columns.Count).End(xlToLeft).Column))
      'si la cellule est vide ou contient 0 ce n'est pas la peine de la traiter
      If D <> "" And D.Value > 0 Then
        'Ecriture de l'erreur autant de fois qu'indiqué dans la cellule
        For B = 1 To D.Value
          wsh.Cells(ligne, 1) = .Cells(C.Row, 1) 'écriture matricule
          wsh.Cells(ligne, 2) = .Cells(1, D.Column) 'écriture erreur
          ligne = ligne + 1
        Next
      End If
    Next
  End If
Next
End With
Set wsh = Nothing
End Sub

[Kaptain84]

Merci beaucoup, ça marche très bien !
Bon week end.

[mercatog]

Bonjour,
dans le même sens que la proposition de Zyhack que je salue et à l'aide d'un tableau intermédiaire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Transf()
Dim LastLig As Long, i As Long
Dim LastCol As Integer, j As Integer, k As Integer, m As Integer
Dim TabErr
 
With Sheets("Feuil1")
    LastLig = .Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    ReDim TabErr(1 To 2, 1 To 1)
    k = 1
    For i = 2 To LastLig
        For j = 3 To LastCol
            If .Cells(i, j).Value > 0 Then
                For m = 1 To Cells(i, j).Value
                    TabErr(1, k) = .Cells(i, 1).Value
                    TabErr(2, k) = .Cells(1, j).Value
                    k = k + 1
                    ReDim Preserve TabErr(1 To 2, 1 To k)
                Next m
            End If
        Next j
    Next i
End With
With Sheets("Feuil2")
    .Range(.Cells(2, 1), .Cells(k + 1, 2)) = Application.Transpose(TabErr)
End With
End Sub

[Kaptain84]

Bonjour, et merci pour vos réponse efficaces !

Je reviens vers vous aujourd'hui car j'ai un soucis d'adaptation de ce script à mon besoin.

En effet, il y a des différences entre le tableau générique utilisé à titre explicatif et le tableau réel, les voici :

La liste des matricules se trouvent bien dans la feuil1 mais dans la colonne B à partir de la ligne 12 (entêtes ligne 11) et les erreurs commencent dans la 12ème colonne (soit L).
Lors des tentatives de modification, je me retrouve soit avec les valeurs de la 1ere colonne à la place des matricules, et aucune erreur recensée, soit avec une incompatibilité de type.

Pourriez vous m'éclairer ?

Merci

[zyhack]

Bonjour

ne sachant pas lequel tu as utilisé j'ai modifié les deux codes avec des commentaires pour que tu retrouve les lignes ou j'ai effectuer les modifications.

celui de mercatog

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Transf()
Dim LastLig As Long, i As Long
Dim LastCol As Integer, j As Integer, k As Integer, m As Integer
Dim TabErr
 
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row 'colonne "B" matricule
    LastCol = .Cells(11, .Columns.Count).End(xlToLeft).Column '11 = ligne entete
    ReDim TabErr(1 To 2, 1 To 1)
    k = 1
    For i = 12 To LastLig ' a partir de la ligne 12
        For j = 12 To LastCol ' a partir de la colonne 12 ("L")
            If .Cells(i, j).Value > 0 Then
                For m = 1 To Cells(i, j).Value
                    TabErr(1, k) = .Cells(i, 2).Value'écriture matricule : 2 = ("B")
                    TabErr(2, k) = .Cells(11, j).Value'écriture erreur ligne entete = 11
                    k = k + 1
                    ReDim Preserve TabErr(1 To 2, 1 To k)
                Next m
            End If
        Next j
    Next i
End With
With Sheets("Feuil2")
    .Range(.Cells(2, 1), .Cells(k + 1, 2)) = Application.Transpose(TabErr)
End With
End Sub

et le mien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub arrangement()
Dim wsh As Worksheet, B As Integer
Dim C As Range, D As Range, ligne As Long
Set wsh = Worksheets("Feuil2")
ligne = 2
With Worksheets("Feuil1")
'boucle dans les lignes
For Each C In .Range("B12:B" & .Cells(Rows.Count, 1).End(xlUp).Row) 'B12:B : dans les matricule a partir de la ligne 12
  If C <> "" Then 'en cas de ligne vide
    'boucle dans les colonnes :        12 eme colonne ="L"
    For Each D In .Range(.Cells(C.Row, 12), .Cells(C.Row, .Cells(C.Row, Columns.Count).End(xlToLeft).Column))
      'si la cellule est vide ou contient 0 ce n'est pas la peine de la traiter
      If D <> "" And D.Value > 0 Then
        'Ecriture de l'erreur autant de fois qu'indiqué dans la cellule
        For B = 1 To D.Value
          wsh.Cells(ligne, 1) = .Cells(C.Row, 2) 'écriture matricule : 2 = ("B")
          wsh.Cells(ligne, 2) = .Cells(11, D.Column) 'écriture erreur ligne entete = 11
          ligne = ligne + 1
        Next
      End If
    Next
  End If
Next
End With
Set wsh = Nothing
End Sub