Discussion :

[Dkterreur]

Bonjour à tous;
je suis débutant dans excel et je cherche une macro VBA afin de passer de la version 1 à la version 2







Merci bcp

[ARTURO83]

Bonjour,

Voilà, plus qu'à cliquer sur le bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Avec le fichier
Pièce jointe 468931

Cdlt

[BENNASR]

bonjour ARTURO83, Dkterreur, la forum
J'ai tester le code qui fonctionne parfaitement seulement seulement j'ai ajouter : (And Cells(i, "B") <> "") car ton code ajoute deux ligne si la dernière ligne contient un agent et un pays :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
'Compléter liste des agents
    For i = 3 To DerLig
        If Cells(i, "A") = "" And Cells(i, "B") <> "" Then Cells(i, "A") = Cells(i - 1, "A")
    Next i

[ARTURO83]

Bonjour BENNASR,

Merci pour la correction

Cdlt