modification d'un tableau de données

[Laika]

Bonjour,
je cherche à modifier un tableau sous excel.

en colonnes, il y a les n° de semaines
en lignes des n° de machines
aux intersections les types d'articles fabriqués.

la modification rapide que je souhaite faire est:

en colonnes,laisser les n° de semaines
en lignes positionner les types d'articles
aux intersections retrouver les n° de machines

merci de m'apporter de l'aide( fonction recherche ou macro)

cordialement

[bosk1000]

as-tu essayer sur une autre feuille de faire une matrice en utilisant la fonction "recherchev"
ça peux peu-etre solutioner ton problème
as-ta disposition pour plus d'explication si besoins

[arosec]

Bonsoir,

Voici une macro qui pourrait faire ce travail...
On peu long tout de même ... (il doit y avoir plus simple)

- L'onglet Feuil1 contient la mise en forme actuelle (semaines/machines).
- La nouvelle mise en forme est mise dans l'onglet existant Feuil2 (semaines/produits).

Code :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
 
Sub ExtractTransposeData()
Dim sheetSrc As Worksheet
Dim sheetDst As Worksheet
Dim rSrc As Long
Dim cSrc As Integer
Dim tabData() As String
Dim tabProd() As String
Dim tabSema() As String
Dim nbData As Long
Dim i As Long
Dim j As Long
Dim sem As String
Dim pro As String
Dim mac As String
Dim sep As String
Dim c As Integer
Dim r As Long
 
On Error GoTo lblErr
Application.ScreenUpdating = False
 
'Mettre les données de la feuille Excel dans un tableau
Set sheetSrc = ThisWorkbook.Worksheets("Feuil1")
cSrc = 2
i = 0
While sheetSrc.Cells(1, cSrc) > "" 'Parcourir les Semaines
  rSrc = 2
  While sheetSrc.Cells(rSrc, 1) > "" 'Parcourir les Machines
    If sheetSrc.Cells(rSrc, cSrc) > "" Then 'Alimenter le tableau si un Produit est présent
      i = i + 1
      ReDim Preserve tabData(3, i)
      tabData(1, i - 1) = sheetSrc.Cells(1, cSrc) 'Semaine
      tabData(2, i - 1) = sheetSrc.Cells(rSrc, cSrc) 'Produit
      tabData(3, i - 1) = sheetSrc.Cells(rSrc, 1) 'Machine
    End If
    rSrc = rSrc + 1
  Wend
  cSrc = cSrc + 1
Wend
Set sheetSrc = Nothing
nbData = i
 
'Dresser la liste des Semaines
For i = 0 To nbData - 1
  ReDim Preserve tabSema(i + 1)
  tabSema(i) = tabData(1, i)
Next i
'Trier le tableau des Semaines
For i = 0 To UBound(tabSema) - 1
  For j = i To UBound(tabSema) - 1
    If UCase(tabSema(j)) < UCase(tabSema(i)) Then
      sem = tabSema(i)
      tabSema(i) = tabSema(j)
      tabSema(j) = sem
    End If
  Next j
Next i
 
'Dresser la liste des Produits
For i = 0 To nbData - 1
  ReDim Preserve tabProd(i + 1)
  tabProd(i) = tabData(2, i)
Next i
'Trier le tableau des Produits
For i = 0 To UBound(tabProd) - 1
  For j = i To UBound(tabProd) - 1
    If UCase(tabProd(j)) < UCase(tabProd(i)) Then
      prod = tabProd(i)
      tabProd(i) = tabProd(j)
      tabProd(j) = prod
    End If
  Next j
Next i
 
'Remplir une nouvelle feuille en transposant les données
Set sheetDst = ThisWorkbook.Worksheets("Feuil2")
 
'Ajouter les Semaines en Colonne
r = 1
sem = 0
For i = 0 To UBound(tabSema) - 1
  If sem <> tabSema(i) Then
    c = c + 1
    sem = tabSema(i)
    sheetDst.Cells(1, c) = sem
  End If
Next i
 
'Ajouter les Produits en Ligne
c = 1
pro = ""
For i = 0 To UBound(tabProd) - 1
  If pro <> tabProd(i) Then
    r = r + 1
    pro = tabProd(i)
    sheetDst.Cells(r, 1) = pro
  End If
Next i
 
'Ajouter les Machines à l'intersection des Semaines/Produits
c = 2
While sheetDst.Cells(1, c) > ""
  sem = sheetDst.Cells(1, c)
  r = 2
  While sheetDst.Cells(r, 1) > ""
    prod = sheetDst.Cells(r, 1)
    mac = ""
    sep = ""
    For i = 0 To nbData - 1
      If tabData(1, i) = sem Then
        If tabData(2, i) = prod Then
          mac = mac & sep & tabData(3, i)
          sep = ";"
        End If
      End If
    Next i
    sheetDst.Cells(r, c) = mac
    r = r + 1
  Wend
  c = c + 1
Wend
 
GoTo lblFin
 
lblErr:
MsgBox Err.Description
 
lblFin:
Set sheetDst = Nothing
Application.ScreenUpdating = True
End Sub

Cdt,

[Benoit Schwob]

Bonsoir,

Une piste...

Dans un premier temps, normalise ta base, c'est à dire réduis-là à une base de 3 colonnes :
- n° de machines
- types d'articles
- n° de semaines.

Ca peut être un peu fastidieux à monter (pas le genre de chose à faire en passant un coup de fil en même temps), mais c'est complètement possible surtout que tu as a priori un nombre raisonnable de semaines, non ?
- une série de couper-coller de tes plages de types d'articles pour les transformer en une seule colonne
- recopier/ajuster vers le bas le bloc des n° de machines.

Ensuite, avec quelques astuces, un TCD te fait des miracles.
On parlait de quelque chose de très proche par là :
http://www.developpez.net/forums/d10...fichier-excel/

Benoît

[arosec]

Bonsoir Benoit Schwob,

j'ai un doute sur le TBC...
La machine n'est pas un indicateur mais une dimension .

[Benoit Schwob]

Bonjour,

Pas besoin d'indicateur, certes : on travaille uniquement avec des dimensions.

Ce n'est peut-être pas l'esprit originel du TCD mais ça permet de faire ça quand-même : une fois qu'on a une base normalisée (sur 3 colonnes), le TCD puis un peu de bricolage remontent le tableau "à l'envers".

Ci-joint un exemple :
- j'y ai déroulé les étapes d'onglet en onglet ;
- je ne suis pas sûr que le tableau initial de Laika soit exactement structuré comme ça, mais bon...
- le passage de l'étape 1 à l'étape 2 est un poil fastidieux : il pourrait aussi être fait avec un TCD, mais vu qu'on a un nombre réduit de semaines ce n'est pas forcément la peine...

Cordialement,

Benoît