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
| Option Explicit
Sub Traitement()
Dim Lastlig As Long
Dim Tb, Tablo, Tp
Dim Ind As Byte
Application.ScreenUpdating = False
With Worksheets("BD")
Lastlig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A8:J" & Lastlig)
End With
Tp = Array("Beta", "Delta")
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(Tp).Clear
On Error GoTo 0
Application.DisplayAlerts = False
For Ind = 0 To 1
Tablo = Dispatch(Tb, Tp(Ind))
With Worksheets(Tp(Ind))
.Name = UCase(Tp(Ind))
.Range("A1") = Tp(Ind)
.Range("A7").Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
.Range("A9").Resize(UBound(Tablo, 1) - 2, UBound(Tablo, 2)).Sort Key1:=.Range("A9"), order1:=xlAscending, Header:=xlNo
End With
Next Ind
End Sub
'/!\ Active la référence Microsoft Scripting Runtime
Private Function Dispatch(ByVal Tb, ByVal Typ As String)
Dim Ouvrage As New Scripting.Dictionary
Dim PosteDirect As New Scripting.Dictionary
Dim C As Integer, m As Integer, R As Integer, n As Integer
Dim p As Integer, i As Integer, j As Integer, k As Integer
Dim Res(), Tmp, Vemp
p = UBound(Tb, 1)
For i = 1 To p
If Tb(i, 2) = Typ Then
Ouvrage(Tb(i, 3)) = ""
PosteDirect(Tb(i, 4) & "|" & Tb(i, 9)) = ""
End If
Next i
C = Ouvrage.Count
m = 5 + 2 * C
R = PosteDirect.Count
n = 2 + R
ReDim Res(1 To n, 1 To m)
Res(1, 1) = "N°"
Res(1, 2) = "Alim"
Res(1, 3) = "Alim"
Res(2, 2) = "(V)"
Res(2, 3) = "(A)"
For j = 0 To 2 * C - 1
k = Int(j / 2)
Res(1, j + 4) = Ouvrage.Keys(k)
Res(2, 2 * k + 4) = "(mV)"
Res(2, 2 * k + 5) = "(mA)"
Next j
Res(1, m - 1) = "Dire"
Res(1, m) = "Observations" ' (" & Typ & ")"
For i = 3 To n
Vemp = Split(PosteDirect.Keys(i - 3), "|")
Res(i, 1) = Vemp(0)
For j = 4 To m - 2 Step 2
k = Int((j - 4) / 2)
Tmp = Sum(Tb, Typ, Vemp(1), Ouvrage.Keys(k), Res(i, 1))
If Res(i, 2) = "" Then Res(i, 2) = Tmp(0)
If Res(i, 3) = "" Then Res(i, 3) = Tmp(1)
Res(i, j) = Tmp(2)
Res(i, j + 1) = Tmp(3)
Res(i, m) = Res(i, m) & "" & Tmp(5)
Next j
Res(i, m - 1) = Vemp(1)
Next i
Set Ouvrage = Nothing
Set PosteDirect = Nothing
Dispatch = Res
End Function
Private Function Sum(ByVal Tb, ByVal Typ As String, ByVal Dire As String, ByVal Ouv As String, ByVal Post As String)
Dim Tablo(0 To 5)
Dim i As Integer
Dim t As Byte
For i = 1 To UBound(Tb, 1)
If Tb(i, 2) = Typ And Tb(i, 3) = Ouv And Tb(i, 4) = Post And Tb(i, 9) = Dire Then
For t = 0 To 5
Tablo(t) = Replace(Tb(i, 5 + t), Chr(10), " ")
Next t
Exit For
End If
Next i
Sum = Tablo
End Function |
