Explication d'un code VBA
Bonjour
quelqu'un pourrait il m'expliquer ce code de façon la plus détaillé possible svp
Option Explicit
'/!\ Active la Référence Microsoft Scripting Runtime
Sub Traiter()
Dim Wbk As Workbook
Dim Fichier
Fichier = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If Fichier <> False Then
Set Wbk = Workbooks.Open(Fichier)
Recap Wbk.Worksheets(1).Range("A3")
Wbk.Close True
Set Wbk = Nothing
End If
MsgBox "Traitement terminé..."
End Sub
Private Sub Recap(ByVal Rng As Range)
Dim LastLig As Long, i As Long, j As Long, N As Long
Dim Dico As Scripting.Dictionary
Dim Tb, Tmp, Res()
Dim Str As String
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Feuil1")
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:D" & LastLig)
End With
Set Dico = New Scripting.Dictionary
For i = 1 To LastLig - 1
Str = Tb(i, 2) & "µ" & Tb(i, 4)
If Not Dico.Exists(Str) Then
Dico.Add Str, CStr(i)
Else
Dico(Str) = Dico(Str) & ";" & CStr(i)
End If
Next i
N = Dico.Count
If N > 0 Then
ReDim Res(1 To N, 1 To 6)
For j = 1 To N
Tmp = Split(Dico.keys(j - 1), "µ")
Res(j, 1) = Tmp(0)
Res(j, 6) = Tmp(1)
Res(j, 5) = Nb(Dico.Items(j - 1))
Next j
Rng.Resize(N, 6) = Res
End If
Set Dico = Nothing
End Sub
Private Function Nb(ByVal Str As String, Optional ByVal Sep As String = ";") As Integer
Nb = Len(Str) - Len(Replace(Str, Sep, "")) + 1
End Functionmerci
Hello,
C'est normalement le truc que je n'aime pas trop faire, et j'imagine, le forum non plus et c'est pourquoi tu n'as pas eu de réponse avant.
En effet, commenter un code qu'on a pas réalisé est toujours délicat, surtout si on a que le code comme ça balancé.
Au moins joindre le classeur qui va avec, sans données confidentielles serait bien. Et il est pas des plus simple à expliquer.
J'espère quand même que tes connaissances en programmation sont quand même un peu avancées pour comprendre ce code...
Je te signale qu'il y a 2-3 trucs que je n'ai pas bien compris non plus... Et oui sans avoir fait le code...
'Oblige de déclarer les variables
Option Explicit
'======================================================================
'Ici le développeur de la macro dit qu'il faut :
'/!\ Activer la Référence Microsoft Scripting Runtime
'Dans Outils/Références tu cherches cette référence dans la liste et tu la côches
'======================================================================
'Macro "Traiter"
Sub Traiter()
'Déclarations des variables
Dim Wbk As Workbook '"Wbk" étant un classeur
Dim Fichier As String '"Fichier" étant une chaîne de caractère
'La variable "fichier" aura comme valeur le chemin et le nom du fichier choisit
Fichier = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
'Si un fichier est donc choisit alors
If Fichier <> False Then
' la variable "Wbk" = ouverture du fichier choisit
Set Wbk = Workbooks.Open(Fichier)
'Appelle la macro "Recap" et sélectionne la cellule A3 de la "Feuil1"
Recap Wbk.Worksheets(1).Range("A3")
'Ferme le classeur (le "True" est facultatif)
Wbk.Close True
'Réinitialise la variable "Wbk" ou plus justement, libère l'espace alloué pour cette variable
Set Wbk = Nothing
'Fin de la condition
End If
'Affiche le message "Traitement terminé..."
MsgBox "Traitement terminé..."
End Sub
'Macro "Recap" qui demande en paramètre une cellule
Private Sub Recap(ByVal Rng As Range)
'Déclare les variables
'Si tu veux savoir plus sur les types de variables, tu peux aller voir
'à cette adresse -> http://www.excel-downloads.com/forum/81052-vba-types-de-variables.html
'Ici les variables sont de types :
'Long (attend un nombre)
'"Scripting.Dictionary" déclare la variable "Dico" comme étant un objet.
'"Scripting.Dictionary" est un "dictionnaire" c'est comme un tableau mais plus performant je crois.
'Si tu veux plus de détails, regarde l'excellent site de Boisgontier.
'http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm
'"Res()" est un tableau et j'imagine que "Tb" et "Tmp" aussi
'String (attend une chaîne de caractère),
Dim LastLig As Long, i As Long, j As Long, N As Long
Dim Dico As Scripting.Dictionary
Dim Tb, Tmp, Res()
Dim Str As String
'Évite le scintillement de l'écran pendant le traitement
'Normalement il faut y remettre à "True" en fin de procédure
Application.ScreenUpdating = False
'Sur ou avec (si tu préfères) la feuille "Feuil1"
With ThisWorkbook.Worksheets("Feuil1")
'La variable "LastLig" = le numéro de la dernière ligne pleine de la colonne A de "Feuil1"
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
'La variable Tb (un tableau donc) = la plage "A2:D et dernièr numéro (LastLig)"
'Donc si la dernière ligne pleine de la colonne A est A500,
'la plage sera A2D500.
Tb = .Range("A2:D" & LastLig)
'Fin du block With
End With
'Là ça se corse un peu pour t'expliquer parce que les dictionnaires ce n'est pas mon fort !
'Donc à partir de là, disons que je mets tout entre parenthèse. Casi sûr mais pas certain :-/
'Initialise la variable "Dico" comme un nouveau objet dictionnaire
Set Dico = New Scripting.Dictionary
'"i" = Boucle de 1 à la (toujours LastLig) dernièr numéro de ligne de la colonne A
'Si on garde le 500 comme dernier numéro de ligne, la boucle serait de 1 à 499
For i = 1 To LastLig - 1
'La variable String "Str" = le tableau Tb donc la plage non pas A2:D & LastLig,
'mais B2:D & LastLig.
'Le "µ" me pose problème, je crois que c'est un espace !
Str = Tb(i, 2) & "µ" & Tb(i, 4)
'Si dans le dictionnaire "Dico" il n'y a pas un des items de cette plage alors
If Not Dico.Exists(Str) Then
'Rappel que les dictionnaires travaillent avec des clès uniques
'pour éviter les doublons
'Rajoute la clé au dictionnaire (Str) et sa valeur associée CStr(i)
'La fonction CStr convertit en texte... comme i est forcément de type numérique,
'il y convertit en texte.
Dico.Add Str, CStr(i)
'Sinon (si il y est)
Else
'Pas certain de ce que ça veut dire, je crois que Dico reste tel quel.
Dico(Str) = Dico(Str) & ";" & CStr(i)
'Fin de la condition
End If
'Fin de la boucle
Next i
'La variable "N" = le nombre d'item dans le dico (si on garde LastLig ça fait 500 items)
N = Dico.Count
'Si "N" est plus grand que 0 alors
If N > 0 Then
'Redimensionne le tableau "Res" de 1 à N lignes et de 1 à 6 colonnes
ReDim Res(1 To N, 1 To 6)
'La variable "j" = boucle de 1 à N
For j = 1 To N
'La variable "Tmp" (qui est donc un tableau) = (si je comprends bien) les clés séparées d'un espace ??
Tmp = Split(Dico.keys(j - 1), "µ")
'(si je comprends bien) la première colonne du tableau "Tmp" = la première
'colonne du tableau "Res"
Res(j, 1) = Tmp(0)
'(si je comprends bien) la deuxième colonne du tableau "Tmp" = la sixième
'colonne du tableau "Res"
Res(j, 6) = Tmp(1)
'"Nb" est la fonction privée créée plus bas par le concepteur qui demande un nombre
'en paramètre.
'Nb = la cinquième colonne du tableau "Res"
'"Dico.Items(j - 1)" = un numéro "j" -1
Res(j, 5) = Nb(Dico.Items(j - 1))
'Fin de la boucle
Next j
'Le tableau "Res" = la plage Rgn redimensionnée ??? je ne sais même pas
'ce que c'est Rgn ?? si c'est une variable, va falloir la déclarer ou erreur !
Rng.Resize(N, 6) = Res
'Fin de la condition
End If
'Libère l'espace alloué pour la variable "Dico"
Set Dico = Nothing
End Sub
'Fonction privée
Private Function Nb(ByVal Str As String, Optional ByVal Sep As String = ";") As Integer
'Len = Renvoie le nombre de caractère d'une chaîne de caractère.
'Replace = Remplace un caractère voulu par un autre.
' Nb = le nombre de caractère de Str - le nombre de ";" + 1
Nb = Len(Str) - Len(Replace(Str, Sep, "")) + 1
End FunctionEspérant t'avoir aidé.
Bonjour,
D’abord bravo à Hulk pour son travail de dissection.
En complément, voici une explication éventuelle de l’utilisation du dictionnaire. Celui-ci permet d’établir une liste sans doublon des textes composés de la concaténation des valeurs de la colonne B et de la colonne D du classeur actif (ce pourrait être un Nom et prénom par exemple).
Le programme effectue également le comptage du nombre de fois que chacun de ces textes apparait puis effectue une copie du résultat dans la Feuil1 du fichier qui a été ouvert.
A+