Remplacer Formules par une Macro

[alain18]

Bonjour à tous,
N'étant pas un spécialiste des macros, je viens vers le forum pour savoir s'il serait possible de remplacer mes formules par une Macro permettant d'effectuer le même travail.
Pour mieux comprendre ma question, je vous joins le fichier en question.
Par avance, je vous remercie.

 

[Fred0o]

Re : Remplacer Formules par une Macro

Bonjour alain18,

Voici une proposition en pièce jointe.

A+

 

[alain18]

Re : Remplacer Formules par une Macro

Merci Fred0o pour cet exemple qui fonctionne en l'état. Toutefois je n'ai pas été complet (comme d'habitude !!) car il est possible que dans la colonne Noms il y ai des absents et de ce fait dans la colonne "C" le numéro de département sera supprimé mais la ligne,elle, ne le sera pas. Ceci afin de connaître quel NOM est absent.
Dans ce cadre lorsque je supprime un ou deux n° de dépte la macro bug.
En résumé la colonne "Depte" peut avoir des cellules vides. C'est peut ètre plus simple ainsi.
D'autre part serait il possible (pour améliorer mes connaissances) de me préciser dans la macro les opérations réalisées sur quelques lignes de commande ?
Merci.

 

[Robert]

Re : Remplacer Formules par une Macro

Bonjour Alain, Fred0o, bonjour le forum,

Comme j'ai aussi travaillé sur ton problème je t'envoie ma proposition avec le code ci-dessous :

Sub Macro1()
Dim ad As Range 'déclare la variable ad (Anciennes Données)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELlule)

With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    'efface les anciennes données
    Set ad = .Range("F5").CurrentRegion 'définit la variable ad
    If ad.Rows.Count > 1 Then 'condition : si le nombre de ligne de ad est supérieur à 1
        Set ad = ad.Offset(1, 0).Resize(ad.Rows.Count - 1, 2) 'redéfinit ad (sans la ligne des étiquettes)
        ad.ClearContents 'efface le contenu de ad
    End If 'fin de la condition
    dl = .Cells(Application.Rows.Count, 4).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 4 (=D)
    Set pl = .Range("D6:D" & dl) 'définit la plage pl
    Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
    For Each cel In pl 'boucle sur toutes les cellule cel de la plage pl
        If cel.Value <> "" Then dico(cel.Value) = dico(cel.Value) + 1 'si la cellule n'est pas vide incrémente le nombre
    Next cel 'prochaine cellule de la boucle
    .Range("F6").Resize(dico.Count) = Application.Transpose(dico.keys) 'place en F6 la liste triée et sans doublons
    .Range("G6").Resize(dico.Count) = Application.Transpose(dico.items) 'place en G6 le nombre par départment
    'tri croissant par département
    .Range("F5").CurrentRegion.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End With 'fin de la prise en compte de l'onglet "Feuil1"
End Sub

Le fichier :

 

[Fred0o]

Re : Remplacer Formules par une Macro

Re-bonjour alain18,

Voici la macro modifiée et commentée :

Sub Comptage()
    Dim d As Integer, l As Integer, Dep(1 To 99)

'   Pour n° de département = 1 à 99, on vide le tableau de comptage des noms
    For d = 1 To 99
        Dep(d) = 0
    Next
    
'   Pour ligne = 6 à dernière ligne occupée de la colonne C
    For l = 6 To Range("C65536").End(xlUp).Row
    
'   Si le n° de département contenu dans la ligne l n'est pas vide, on comptabilise +1 dans
'       le tableau de comptage, au n° de département correspondant
        If Not IsEmpty(Cells(l, 4)) Then Dep(Cells(l, 4)) = Dep(Cells(l, 4)) + 1
    Next
'   On se repositionne en ligne 6
    l = 6
'   Ensuite, on parcours le tableau de comptage et chaque fois que le comptage d'un département n'est pas = 0
'       alors on écrit le n° de département et le nombre de noms dans les colonnes F et G
    For d = 1 To 99
        If Dep(d) > 0 Then
            Cells(l, 6) = d
            Cells(l, 7) = Dep(d)
            l = l + 1
        End If
    Next
End Sub

A+

 

[pierrejean]

Re : Remplacer Formules par une Macro

Bonjour alain18
Salut FredOo

Une autre version qui admet autant de lignes qu'il peut y en avoir et autant de departement existants en colonne D (y compris les DOM TOM et quelle qu'en soit l'appelation ex 01 Ain , 69 Rhône etc)

Edit : Salut Robert (avais pas rafraichi !!)

 

[alain18]

Re : Remplacer Formules par une Macro

Merci à tous c'est sympa,
Je n'ai que l'embaras du choix. Maintenant cela fonctionne correctement. Je dois maintenant mettre en application.
Toutefois, Pierrejean, j'ai constaté qu'en supprimant quelques N° de Dépt dans la colonne "G" (Nbre/Dept) un chiffre supplémentaire s'affiche. Il correspond apparament au nombre de cellules vide en colonne "D". Cela peut il ètre évité ? Voir PJ.
Merci.

 

[pierrejean]

Re : Remplacer Formules par une Macro

Re

OK voila une nouvelle version

NB: La solution de ROBERT (voisine de la mienne ) ne comporte pas cet inconvenient

 

[alain18]

Re : Remplacer Formules par une Macro

RE
OK, Merci pierrejean pour ta réactiviter.
Je vais mettre tout ça en musique.....
Bien sûr, si j'ai un problème je repasserai.
A la prochaine.