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
| Sub GrandesValeurs()
Dim D() As Variant, R() As Variant
Dim d1 As Object
Dim C As Range '! Single, #DOuble
Dim temp$, temp1!, temp2!, L1%, L2%, i As Byte, j As Byte
Dim temp11!, temp22!, NS$
Dim Tbl() As tabloStructure
Set d1 = CreateObject("Scripting.Dictionary")
R = Range("A2:G" & [A65000].End(xlUp).Row)
For Each C In Range("A2", [A65000].End(xlUp))
temp = C.Value
If Not d1.exists(temp) Then
d1.Add temp, temp
End If
Next C
D = d1.keys 'Obtient les éléments
ReDim Tbl(0)
ReDim Preserve Tbl(4)
temp = 0 'NCS
temp1 = 0 'QS
temp2 = 0 'QT
NS = ""
L1 = 1: L2 = 1
For i = 0 To UBound(D)
For j = LBound(R) To UBound(R)
If D(i) = R(j, 1) Then
L1 = j: L2 = j
If R(j, 6) >= temp1 Then
temp11 = temp1
temp1 = R(j, 6)
'L1 = j
NS = NS & "|" & R(j, 2)
End If
If R(j, 7) >= temp2 Then
temp22 = temp2
temp2 = R(j, 7)
'L2 = j
NS = NS & "|" & R(j, 2)
End If
End If
Next j
Dim N$()
N = Split(NS, "|")
temp = Application.Max(UBound(N))
Tbl(i + 1).Tab_1 = temp: Tbl(i + 1).Tab_2 = temp1: Tbl(i + 1).Tab_3 = temp2
Next i
Range("K2").Resize(d1.Count + 1) = Application.Transpose(d1.keys)
'Range("K2").Resize(UBound(Tbl), 4) = Tbl
End Sub |
Partager