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
| Option Explicit
Sub ChNoirhomme()
Dim i, j As Integer
Dim rng_tab As Range
Dim table_pays_pays()
Dim rd As Integer
Dim bool As Boolean
With Worksheets("Feuil1")
Set rng_tab = .Range("B2")
rd = 1
ReDim table_pays(1 To 3, 1 To rd)
table_pays(1, rd) = rng_tab.Offset(0, -1)
table_pays(2, rd) = rng_tab
table_pays(3, rd) = rng_tab.Offset(0, 1)
For i = 1 To .Columns(2).Find("*", , , , , xlPrevious).Row - 1
If rng_tab.Offset(i, 0) <> "" Then
bool = True
For j = LBound(table_pays, 2) To UBound(table_pays, 2)
If (rng_tab.Offset(i, 0) = table_pays(2, j) And rng_tab.Offset(i, -1) = table_pays(1, j)) Then
table_pays(3, j) = table_pays(3, j) + rng_tab.Offset(i, 1)
bool = False
Exit For
End If
Next j
If bool Then
rd = rd + 1
ReDim Preserve table_pays(1 To 3, 1 To rd)
table_pays(1, rd) = rng_tab.Offset(i, -1)
table_pays(2, rd) = rng_tab.Offset(i, 0)
table_pays(3, rd) = rng_tab.Offset(i, 1)
End If
End If
Next i
' .Range("E1") = "Type"
' .Range("F1") = "Pays"
' .Range("G1") = "QTY Total"
.Range("E2:G" & .Columns(7).Find("*", , , , , xlPrevious)).ClearContents
Set rng_tab = .Range("E1")
For i = LBound(table_pays, 2) To UBound(table_pays, 2)
For j = 0 To 2
rng_tab.Offset(i, j) = table_pays(j + 1, i)
Next j
Next i
End With
End Sub |
Partager