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
| Option Explicit
Sub Former()
Dim LastLig As Long, NewLig As Long, i As Long, N As Long, Nb As Long
Dim LastCol As Integer, j As Integer, Nc As Integer
Dim Tb, Res, Tbl, Tmp, Cpl, MesDates
Dim MonDico As Object
Application.ScreenUpdating = False
With Worksheets("Feuil1") 'A adapter
LastLig = .Cells(.Rows.Count, 3).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Tb = .Range("A1").Resize(LastLig, LastCol)
End With
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 2 To LastLig
If Tb(i, 1) = "" Then Tb(i, 1) = Tb(i - 1, 1)
If Not MonDico.exists(Tb(i, 3)) Then
MonDico.Add Tb(i, 3), Tb(i, 1) & "|" & F(Tb, i)
Else
MonDico(Tb(i, 3)) = MonDico(Tb(i, 3)) & "µ" & Tb(i, 1) & "|" & F(Tb, i)
End If
Next i
MesDates = LesDates(Tb)
N = MonDico.Count
Nb = (LastLig - 1) / N
Nc = LastCol - 3
Tbl = MonDico.Items
With Worksheets("Feuil2") 'A adapter
.UsedRange.Clear
.Range("A1:B1") = Array("Objet", "Date")
.Range("C1").Resize(1, N) = MonDico.Keys
Set MonDico = Nothing
For i = 0 To N - 1
Res = Split(Tbl(i), "µ")
NewLig = 2
For j = 0 To Nb - 1
Cpl = Split(Res(j), "|")
If i = 0 Then
.Cells(NewLig, 1).Resize(Nc, 1) = Application.Transpose(Cpl(0))
.Cells(NewLig, 2).Resize(Nc, 1) = MesDates
End If
Tmp = Split(Cpl(1), ";")
.Cells(NewLig, i + 3).Resize(Nc, 1) = Application.Transpose(Tmp)
NewLig = NewLig + Nc
Next j
Next i
End With
End Sub
Private Function F(ByVal Tb, ByVal i As Long) As String
Dim S As String
Dim j As Integer
For j = 4 To UBound(Tb, 2)
S = S & ";" & Tb(i, j)
Next j
F = Mid(S, 2)
End Function
Private Function LesDates(ByVal Tb)
Dim j As Integer
Dim Tmp()
ReDim Tmp(1 To UBound(Tb, 2) - 3, 1 To 1)
For j = 4 To UBound(Tb, 2)
Tmp(j - 3, 1) = Tb(1, j)
Next j
LesDates = Tmp
End Function |
Extraire les données d'une feuille vers une autre en les organisant via diverses méthodes
Répondre avec citation
) s'exécute assez rapidement je trouve. Mon raisonnement pour la suite du déroulement de la macro me semble bon mais est ce vraiment réalisable? Bref, je renouvelle mon appel à l'aide ! 
)
C'est ma première macro et je tiens à remercier les contributeurs pour leur aide précieuse !!
.
. A première vue j'ai l'impression que tu créer carrément un tableau. Je regarde çà de plus près et reviens vers toi dès que possible.
Partager