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
| Sub Disposition()
Dim DerLig As Long, Lig As Long, Col As Long
Application.ScreenUpdating = False
Columns("G:Z").Clear
DerLig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Compléter liste des agents
For i = 3 To DerLig
If Cells(i, "A") = "" Then Cells(i, "A") = Cells(i - 1, "A")
Next i
'Liste des agents
Lig = 2
For i = 2 To DerLig
If Cells(i, "A") <> Cells(i - 1, "A") Then
Cells(Lig, "G") = Cells(i, "A")
Lig = Lig + 1
End If
Next i
'Liste des Pays
Set D1 = CreateObject("Scripting.Dictionary")
For Each C In Range("B2:B" & DerLig)
'If Not D1.exists(C.Text) Then D1(C.Text) = ""
If C.Text <> "" Then D1(C.Text) = ""
If Not D1.exists(C.Text) Then D1(C.Text) = ""
Next C
If D1.Count > 0 Then
[H1].Resize(1, D1.Count) = Application.Transpose(Application.Transpose(D1.keys))
End If
'Formules pour marquage
Range("G1").Value = " Pays" & Chr(10) & "" & Chr(10) & "Agents"
DerLig = [G2].End(xlDown).Row
DerCol = [G1].End(xlToRight).Column
[H2].FormulaArray = "=IFERROR(IF(MATCH(RC7&"" ""&R1C,C1&"" ""&C2,0)>0,""X"",""""),"""")"
Range("H2").AutoFill Destination:=Range(Cells(2, "H"), Cells(2, DerCol)), Type:=xlFillDefault
Range(Cells(2, "H"), Cells(2, DerCol)).AutoFill Destination:=Range(Cells(2, "H"), Cells(DerLig, DerCol)), Type:=xlFillDefault
'Mise en forme
Range(Cells(1, "G"), Cells(DerLig, DerCol)).Borders().Weight = xlThin
Range("G1").Borders(xlDiagonalDown).Weight = xlThin
Range(Cells(1, "H"), Cells(DerLig, DerCol)).HorizontalAlignment = xlCenter
End Sub |
