Calcul en VBA puis écriture dans une cellule (puis plage de celulle)
d'accord, j'ai compris l'objectif du bout de code. Tu remplaces l'index du dictionnaire qui était la valeur d'une cellule par la valeur macle à laquelle tu lui dis de remplacer par les 5 premiers caractères de la celulle en partant de la gauche. C'est très malin !
Par contre ça ne fonctionne pas dans le cas de la colonne N (14) car dans chaque cellule il il y a ce genre de données :
D1505 - Personnel de caisse
K1302 - Assistance auprès d'adultes
K1303 - Assistance auprès d'enfants
Ca ne prend en compte que les 5 premières lettres mais ne va pas comptabiliser les autres codes Rome. En effet, un individu peut rechercher plusieurs métiers. J'ai ce cas là intégrer dans toutes les formules de DE quasiment.
Je commence à comprendre un peu mieux mais je vais t’embêter encore un peu :p
Merci pour la patience et l'aide.
Je suis assez fier de moi car même si la partie comptage n'est pas juste car j'attends ton astuce, la condition est bonne et fonctionne.
Comment je peux améliorer cette procédure pour qu'ensuite il relance la procédure avec canton qui se décalle d'une cellule vers la droite et la retranscription du résultat aussi, jusqu'à qu'il ne trouve plus de valeur ? Dois-je définir une autre variable qui change de valeur remplace AB et qui devient AC puis AD .. mais comment faire ?
Sub calculerDEoreC1()
Dim compteurDE As Object, resultatDE()
Dim canton As String
' chargement des données
donneesDE = Sheets("BD_DE_123678").Range("A1").CurrentRegion.Value
' ROME ORE colonne 13 | canton colonne 12
' comptage
Set compteurDE = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donneesDE)
canton = Sheets("TB_Diag").Range("AB2").Value
If donneesDE(i, 12) Like canton Then
maCle = Replace(donneesDE(i, 13), "Non renseigné", "")
maCle = Left(maCle, 5)
compteurDE(maCle) = compteurDE(maCle) + 1
End If
Next
' chargement des données et récupération du décompte
romeDE = Sheets("TB_Diag").Range("B3:B" & Sheets("TB_Diag").Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim resultatDE(1 To UBound(romeDE) - 1)
For i = 1 To UBound(romeDE) - 1
resultatDE(i) = compteurDE(romeDE(i, 1))
Next
' tranfert du résultat
Sheets("TB_Diag").Range("AB3").Resize(UBound(resultatDE), 1) = WorksheetFunction.Transpose(resultatDE)
End SubPour info j'ai injecté une base de 100 000 lignes et j'ai fais calculer les 4 premiers cantons + 2 colonnes cela a pris moins de 20 secondes .. c'est incroyable. IL me tarde d'arriver à la terminer.
Merci infiniment.
Steelson, j'ai réussi à créer ma boucle pour remplir les colonnes mais j'ai un soucis. Elle ne me rempli qu'une colonne sur 2 ... je ne vois pas d'où ça vient.
Sub calculerDEoreC1()
Dim compteurDECanton As Object, resultatDE()
Dim canton As String
Dim debut As Integer
Dim DernCol As Integer
DernCol = Cells(2, Cells.Columns.Count).End(xlToLeft).Column
' chargement des données
donneesDE = Sheets("BD_DE_123678").Range("A1").CurrentRegion.Value
' ROME ORE colonne 13 | canton colonne 12
For debut = 28 To DernCol
' comptage
Set compteurDECanton = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donneesDE)
canton = Sheets("TB_Diag").Cells(2, debut).Value
If donneesDE(i, 12) Like canton Then
maCle = Replace(donneesDE(i, 13), "Non renseigné", "")
maCle = Left(maCle, 5)
compteurDECanton(maCle) = compteurDECanton(maCle) + 1
End If
Next
' chargement des données et récupération du décompte
romeDE = Sheets("TB_Diag").Range("B3:B" & Sheets("TB_Diag").Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim resultatDE(1 To UBound(romeDE) - 1)
For i = 1 To UBound(romeDE) - 1
resultatDE(i) = compteurDECanton(romeDE(i, 1))
Next
' tranfert du résultat
Sheets("TB_Diag").Cells(3, debut).Resize(UBound(resultatDE), 1) = WorksheetFunction.Transpose(resultatDE)
debut = debut + 1
Next
End SubComment je peux améliorer cette procédure
' comptage Set compteurDE = CreateObject("Scripting.Dictionary") For i = 2 To UBound(donneesDE) canton = Sheets("TB_Diag").Range("AB2").Value If donneesDE(i, 12) Like canton Then maCle = Replace(donneesDE(i, 13), "Non renseigné", "") maCle = Left(maCle, 5) compteurDE(maCle) = compteurDE(maCle) + 1 End If Next <br>
Pour plus de rapidité il faudrait mettre canton=_____ au-dessus de la boucle
j'ai un soucis. Elle ne me rempli qu'une colonne sur 2 ... je ne vois pas d'où ça vient.
For debut = 28 To DernCol ' comptage debut = debut + 1 Next
Tout simplement parce que tu as rajouté debut=debut+1 ce qui est inutile dans la boucle for, c'est elle qui incrémente ! donc enlève debut=debut+1
Merci Steelson, en effet c'était logique je l'incrémentais puis il passait au suivant.
Par contre canton=_____ quand le mets cela m'indique que _ est un caractère incorrecte et génère une erreur de compilation.
Est-ce que il n'y aurait pas lieu de vider la mémoire dictonnaire entre chaque calcul pour augmenter la vitesse ou un astuce de ce type ?
Comment remplacer ce code par un code qui permet de compter le nombre de code Rome dans une celulle ou il y a d'autres codes ROME dans la chaine de caractère ? celui-ci va récupérer les 5 premiers caractères de la cellule.
If donneesDE(i, 12) Like canton Then
maCle = Replace(donneesDE(i, 13), "Non renseigné", "")
maCle = Left(maCle, 5)
compteurDECanton(maCle) = compteurDECanton(maCle) + 1
End If
Merci steelson !
Steelson, j'en profite pour savoir comment je peux calculer une moyenne de valeur plutot qu'une somme ?
Actuellement on fait ça pour ajouter les valeurs à l'index du ROME : dico(donnees(i, 12)) = dico(donnees(i, 12)) + donnees(i, 17)
Mais comment je peux faire pour qu'un fois qu'il a tout ajouté je calcul la moyenne de l'index du ROME ? sachant que la colonne sur laquelle se trouve les valeurs à faire la moyenne est la colonne T (20)
Par contre canton=_____ quand le mets cela m'indique que _ est un caractère incorrecte et génère une erreur de compilation.
Est-ce que il n'y aurait pas lieu de vider la mémoire dictonnaire entre chaque calcul pour augmenter la vitesse ou un astuce de ce type ?
J'ai abrégé ma réponse, je voulais dire mettre <!--StartFragment-->cantons=sSheets("TB_Diag").Range("AB2").Value<!--EndFragment--> au-dessus de la boucle for, Désolé.
Il faudra en effet voir les optimisations possibles ensuite. Ne faire ceci qu'une seule fois
rome = Sheets("TB_Diag").Range("B3:B" & Sheets("TB_Diag").Range("B" & Rows.Count).End(xlUp).Row).Valuepour tout le monde !
Je ne sais pas s'il faut "vider" les tableaux et dico, cela ferait une opération de plus.
je reviens à la charge un autre problème sur une autre colonne. j'arrive à bien adapter la procédure sur les dates MAIS quand je veux remplacer le mois (ici 01) par une variable qui évoluerai en 02 puis 03 afin de faire une boucle sur les colonnes il ne sort plus de résultats.
If donnees(i, 21) Like "##/01/####" Then dico(donnees(i, 12)) = dico(donnees(i, 12)) + donnees(i, 15)
Next
J'ai essayé de déclarer une variable string . J'ai également essayé de mettre le a directement dans le like à la place du 01 mais rien n'y fait.
a = 1
Mois = "##/0 & a & /####"
Comment remplacer ce code par un code qui permet de compter le nombre de code Rome dans une celulle ou il y a d'autres codes ROME dans la chaine de caractère ? celui-ci va récupérer les 5 premiers caractères de la cellule.
If donneesDE(i, 12) Like canton Then maCle = Replace(donneesDE(i, 13), "Non renseigné", "") maCle = Left(maCle, 5) compteurDECanton(maCle) = compteurDECanton(maCle) + 1 End If
Comment "repérer" un code ROME ? Toujours 1 caractère et 4 chiffres ? ou bien la comparaison avec toutes les valeurs possibles (ce qui serait long).
Dans le premier cas, il y a une méthode qui utilise les expressions régulières.
calculer une moyenne de valeur plutot qu'une somme ?
Actuellement on fait ça pour ajouter les valeurs à l'index du ROME :
dico(donnees(i, 12)) = dico(donnees(i, 12)) + donnees(i, 17)
Il faut créer 2 dico : dicoTotal et dicoNbre, et au niveau du resultat, mettre
resultat(i) = dicoTotal(rome(i, 1))/dicoNbre(rome(i, 1))comme il y a une division, pour ne pas avoir d'erreur, il faut tester si dicoNbre existe, donc
If dicoNbre.Exists(rome(i, 1)) Then resultat(i) = dicoTotal(rome(i, 1))/dicoNbre(rome(i, 1))je reviens à la charge un autre problème sur une autre colonne. j'arrive à bien adapter la procédure sur les dates MAIS quand je veux remplacer le mois (ici 01) par une variable qui évoluerai en 02 puis 03 afin de faire une boucle sur les colonnes il ne sort plus de résultats.
If donnees(i, 21) Like "##/01/####" Then dico(donnees(i, 12)) = dico(donnees(i, 12)) + donnees(i, 15) NextJ'ai essayé de déclarer une variable string . J'ai également essayé de mettre le a directement dans le like à la place du 01 mais rien n'y fait.
a = 1 Mois = "##/0 & a & /####"
Une date c'est un nombre entier, pas du texte. Il faudrait mettre :
If month(donnees(i, 21)) = 1 Then dico(donnees(i, 12)) = dico(donnees(i, 12)) + donnees(i, 15)pourquoi next à la fin de cette ligne ?
Oui l'idée est d'avoir en résultat le nombre de fois où le ROME apparaît dans la colonne N (14). mais ce Code peut être à l'intérieur d'une chaine de caractère de la celulle.
C'est pour ça qu'initialement j'avais cette fonction excel :
=NB.SI(DECALER(BD_DE_123678!$N$1;0;0;NBVAL(ROME_Métier_recherché)-1);"*" &[@ROME]& "*")
Peut importe l'endroit où se trouvait le ROME il me le comptait.
Pour la moyenne je n'arrive à récupérer le nombre de ... j'arrive à des chiffres farfelus dans les 43 000 et des poussières ...
Sub calculerMoyenne()
Dim dicoNbr As Object, resultat()
Dim dicoTotal As Object
' chargement des données
donnees = Sheets("BD_OE_12M").Range("A1").CurrentRegion.Value
' delaire satisfaction colonne 20 | ROME colonne 12
' comptage
Set dicoTotal = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donnees)
dicoTotal(donnees(i, 12)) = dicoTotal(donnees(i, 12)) + donnees(i, 20)
Next
Set dicoNbr = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donnees)
dicoNbr(donnees(i, 12)) = dicoNbr(donnees(i, 12)) + 1
Next
' chargement des données et récupération du décompte
rome = Sheets("TB_Diag").Range("B3:B" & Sheets("TB_Diag").Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim resultat(1 To UBound(rome) - 1)
For i = 1 To UBound(rome) - 1
If dicoNbr.Exists(rome(i, 1)) Then resultat(i) = dicoTotal(rome(i, 1)) / dicoNbr(rome(i, 1))
Next
' tranfert du résultat
Sheets("TB_Diag").Range("k3").Resize(UBound(resultat), 1) = WorksheetFunction.Transpose(resultat)
End SubTu peux simplifier le comptage en mettant
' comptage
Set dicoTotal = CreateObject("Scripting.Dictionary")
Set dicoNbr = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donnees)
dicoTotal(donnees(i, 12)) = dicoTotal(donnees(i, 12)) + donnees(i, 20)
dicoNbr(donnees(i, 12)) = dicoNbr(donnees(i, 12)) + 1
NextPour mettre au point, ajoute un debug.print et ouvre la fenêtre d'exécution dans l'éditeur de macro
For i = 1 To UBound(rome) - 1
If dicoNbr.Exists(rome(i, 1)) Then
resultat(i) = dicoTotal(rome(i, 1)) / dicoNbr(rome(i, 1))
Debug.Print rome(i, 1), dicoTotal(rome(i, 1)), dicoNbr(rome(i, 1))
End If
Nextet on voit qu'en colonne 20, il s'agit de dates ! pas étonnant que tu trouves des 43000..., aujourd'hui nous sommes le "44026" (14/07/2020)
C'est bien la date d'annulation que tu veux moyenner ?
Remplace 20 par 15 !
Oui l'idée est d'avoir en résultat le nombre de fois où le ROME apparaît dans la colonne N (14). mais ce Code peut être à l'intérieur d'une chaine de caractère de la celulle.
C'est pour ça qu'initialement j'avais cette fonction excel :
=NB.SI(DECALER(BD_DE_123678!$N$1;0;0;NBVAL(ROME_Métier_recherché)-1);"*" &[@ROME]& "*")Peut importe l'endroit où se trouvait le ROME il me le comptait.
Je vais regarder ce soir avec les expressions régulières et / ou une comparaison avec toutes les valeurs de ROME.
C'est quoi un ROME ?
Merci Infiniment pour l'aide j'ai pu résoudre le soucis en effet ça venait de là. le ROME c'est le Répertoire Opérationnel des Métiers et des Emplois; Chaque métier est classé dans ce répertoire par secteur (la lettre) puis une série de chiffre. Merci pour ta recherche ce soir !
Je suis en train de m'arracher les cheveux pour extraire la liste des cantons (Colonne L de BD_DE_132678) sans doublons pour les transposer horizontalement sur TB_Diag à partir de la cellule AB2 (2,28).
J'ai tourné avec ta méthode sans résultat j'ai compris comment transposer horizontalement mais au mieux ça ne me transpose qu'un seul canton à l'identique sur 14 colonne. Le chiffre 14 est logique puisque j'ai 14 cantons différents dans cette base. Par contre je trouvais que ça ramait quand ça a presque fonctionné.
Je m'arrache les cheveux, j'y suis presque !
Sub Listecanton()
donnees = Sheets("BD_DE_123678").Range("L2:L" & [L65000].End(xlUp).Row)
Set mondico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donnees)
mondico(donnees(i, 1)) = ""
Next
Sheets("TB_Diag").Cells(2, 28).Resize(1, mondico.Count) = Application.Transpose(mondico.keys)
End Sub2 corrections : sur les donnees et sur transpose
Sub Listecanton()
donnees = Sheets("BD_DE_123678").Range("L2:L" & Sheets("BD_DE_123678").Range("L" & Rows.Count).End(xlUp).Row)
Set mondico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donnees)
mondico(donnees(i, 1)) = ""
Next
Sheets("TB_Diag").Cells(2, 28).Resize(1, mondico.Count) = (mondico.keys)
End SubIl ne seront pas triés mais dans l'ordre dans lequel ils ont été identifiés !
Oui l'idée est d'avoir en résultat le nombre de fois où le ROME apparaît dans la colonne N (14).
Proposition avec les expressions régulières vbscript.regexp (c'est aussi exotique que le Scripting.Dictionary).
Je recherche dans donneesDE(i, 14) toutes les chaînes comportant une lettre majuscule et 4 chiffres [A-Z][0-9]{4}
Sub calculerDE()
Dim compteurDE As Object, resultatDE()
' chargement des données
donneesDE = Sheets("BD_DE_123678").Range("A1").CurrentRegion.Value
' ROME colonne 14
Set obj = CreateObject("vbscript.regexp")
obj.Pattern = "[A-Z][0-9]{4}"
obj.Global = True
' comptage
Set compteurDE = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(donneesDE)
Set tbl = obj.Execute(donneesDE(i, 14))
For j = 0 To tbl.Count - 1
compteurDE(tbl(j)) = compteurDE(tbl(j)) + 1
'Debug.Print tbl(j)
Next
Next
' chargement des données et récupération du décompte
romeDE = Sheets("TB_Diag").Range("B3:B" & Sheets("TB_Diag").Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim resultatDE(1 To UBound(romeDE) - 1)
For i = 1 To UBound(romeDE) - 1
resultatDE(i) = compteurDE(romeDE(i, 1))
Next
' tranfert du résultat
Sheets("TB_Diag").Range("X3").Resize(UBound(resultatDE), 1) = WorksheetFunction.Transpose(resultatDE)
End Sub