Compter valeurs uniques + Condition

[MsVixene]

Bonjour,

j'ai un fichier de suivi pour réaliser des inventaires.

Les biens sont identifiés par des N°d'inventaire, eux mêmes composés de plusieurs lignes, localisés dans des N° de locaux.
On retrouve tout genre de numéros d'inventaire (Chiffres, lettres, chiffres+lettres)

J'ai donc besoin d'aide sur 3 points :

Dans un autre sujet, on vient de créer une maccro qui permet de dire si les N° d'inventaire de l'onglet EXTRACTION sont inventoriables ou non, en fonction de la liste de l'onglet A ENLEVER. (On dit NON si le N° d'inventaire est dans les deux listes, sinon OUI).

Dans le module 4 :
La colonne 10 de longlet EXTRACTION n'existant pas quand on fait l'extraction SAP, j'aimerais copier/coller la mise en forme seulement de la colonne d'avant. J'ai donc fait un petit code avec l'assistant vu que je ne sais pas faire grand chose. Mais la sélection copier ne s'en va pas pour autant, alors que j'ai bien mis un range select après.
Je renomme également la colonne.

J'aimerais rajouter une textBox pendant que la maccro s'exécute car il y a 17000 lignes, donc j'aimerais qu'on patiente pendant ces quelques secondes. J'ai mis une ligne de code mais comment faire pour que la textbox reste ?

Dans le module 2 :
Cette maccro permet de compter le nombre unique N° de locaux des onglets EXTRACTION et RESULTAT, et le nombre unique de N° d'inventaire, puis de le renseigner dans l'onglet POINT A DATE. Seulement, j'aimerais maintenant prendre en compte que l'on sait si le N° d'inventaire doit être inventorié. Donc clairement:
Si pour une ligne, la colonne 10 = OUI, alors compter.
Si pour une ligne, la colonne 10 = NON, alors ne pas compter.

Merci bicoup.

 

[Dranreb]

Re : Compter valeurs uniques + Condition

Si vous ne pouvez pas importer les données toujours dans la même feuille plutôt que de copier la feuille d'un autre classeur vous pouvez utiliser d'autres expressions Workheet pour la feuille extraction: ActiveSheet pour la feuille active, Worksheets(Worksheets.Count) pour la dernière. Mais affectez la par un Set à une variable déclarée As Worksheet dans la Sub CountUniqueItem pour ne pas lui faire isoler 4 fois cette feuille dans la suite du code.

 

[MsVixene]

Re : Compter valeurs uniques + Condition

Alors est-ce que ma ligne Set suffit ci-dessous ?
Le set me demande un =

Sub CountUniqueItem()
Set FExtrac = Worksheets("EXTRACTION")
 FPoint.[E9].Value = NbUnique(FRésu.[B2])
 FPoint.[G9].Value = NbUnique(FRésu.[C2])
 FPoint.[E14].Value = NbUnique(FExtrac.[A2], FExtrac.[J2])
 FPoint.[G14].Value = NbUnique(FExtrac.[B2], FExtrac.[J2])
 End Sub

(Cool le code )

 

[Dranreb]

Re : Compter valeurs uniques + Condition

mettez devant Dim FExtract As Worksheet pour qu'il reconnaisse ce FExtract comme une variable locale de la procédure en évitant toute confusion avec une autre définition ailleurs.

 

[MsVixene]

Re : Compter valeurs uniques + Condition

Super merci beaucoup!

Maintenant, je ne comprends pas vraiment comment fonctionne la fonction NbUnique que vous avez créée.
Si je souhaite exclure quelque N° de locaux, que faut-il rajouter dans la fonction ?
Les N° de locaux à exclure pourront être indiqué dans l'onglet A ENLEVER aussi par exemple.

EDIT : en fait, je ne vois même pas où est ce qu'on indique dans la fonction que l'on parle des différentes colonnes de l'onglet EXTRACTION :O

 

[Dranreb]

Re : Compter valeurs uniques + Condition

Bonjour.

Pour ignorer certains éléments, il faudrait les passer dans un 3ième paramètre, et le plus simple serait peut être de les supprimer du Dictionary s'ils y existent, avant d'affecter son Count à la valeur retournée par la fonction.
Dans la fonction, on ne parle que des colonnes dont on a passé les cellules de leurs 1ères lignes en paramètres RgSuj et RgÀInv.

 

[MsVixene]

Re : Compter valeurs uniques + Condition

Je n'ai pas compris
quels sont les deux premiers paramètres dont on parle ?
Comment supprime t on des éléments du dictionary ?

 

[Dranreb]

Re : Compter valeurs uniques + Condition

Function NbUnique&(ByVal RgSuj As Range, Optional ByVal RgÀInv As Range)

Toujours dans le With, avec Clé: une expression valant l'élément à supprimer:

If .Exists(Clé) then .Remove Key:=Clé

Les méthodes de l'objet sont d'ailleurs suggérées dans une liste lors de la frappe du point. C'est là un autre avantage de passer par un objet convenablement typé au lieu de Object et CreateObject.

 

[MsVixene]

Re : Compter valeurs uniques + Condition

Et comment je lui dis que Clé sont les valeurs que je ne veux pas inclure ?

 

[Dranreb]

Re : Compter valeurs uniques + Condition

Par un 3ième paramètre, optionnel, sous forme de tableau de String si c'est assez figé, ou un Range dont on prendra la Value, et qu'on explorera dans une boucle, où vous mettrez un élément du tableau en guise de Clé.

 

[MsVixene]

Re : Compter valeurs uniques + Condition

Je ne sais faire les tableaux.
J'aimerais plutot les indiquer dans l'onglet à enlever, dans une colonne, la C par exemple.

Mais je n'ai pas compris où mettre le IF et comment déterminer la clé.
Il me reste 1H snif snif

 

[Dranreb]

Re : Compter valeurs uniques + Condition

Ajoutez un troisième paramètre, par exemple Optional ByVal RgSauf As Range
Récupérez sa Value dans un TSauf déclaré sur le même modèle que les TSuj et TÀInv
Faite un boucle For L = 1 To Ubound(TSauf), et prenez TSauf(L, 1) comme valeur de Clé.

 

[KIM]

Bonjour Dranreb,
Bonjour le fil et le forum,
J'utilise ta fonction NbUnique, très pratique. Par contre je modifie la condition en dur dans le code. Je remplace le "Oui" par la valeur souhaitée :
If Not IsEmpty(TSuj(L, 1)) And TÀInv(L, 1) = "Oui" Then .Item(TSuj(L, 1)) = Empty

Peux-tu stp m'aider par :
1/rendre cette valeur comme paramètre pour RgAInv dans la fonction NbUnique.
FPoint.[E14].Value = NbUnique(FExtrac.[A2], FExtrac.[J2], "Oui")
2/ Créer une troisième col en Optionnel (Intersection de 3 col) et la valeur de condition en paramètre.
FPoint.[E14].Value = NbUnique(FExtrac.[A2], FExtrac.[J2], "Oui", FExtrac.[B2], "10589")
Merci d'avance de ton aide
KIM

 

[Dranreb]

Bonjour.
Peut être comme ça :

Function NbUnique&(ByVal RgSuj As Range, _
   Optional ByVal RgÀInv1 As Range, Optional ByVal Val1 = "Oui", _
   Optional ByVal RgÀInv2 As Range, Optional ByVal Val2 = "Oui")
Dim LDéb&, TSuj(), TÀInv1(), TÀInv2(), L&
With RgSuj.Worksheet.UsedRange
   Set RgSuj = RgSuj.Resize(.Row + .Rows.Count - RgSuj.Row): End With
TSuj = RgSuj.Value
With New Scripting.Dictionary ' Implique référence "Microsoft Scripting Runtime"
   If RgÀInv1 Is Nothing Then
      For L = 1 To UBound(TSuj)
         If Not IsEmpty(TSuj(L, 1)) Then .Item(TSuj(L, 1)) = Empty
         Next L
   ElseIf RgÀInv2 Is Nothing Then
      TÀInv1 = Intersect(RgÀInv1.EntireColumn, RgSuj.EntireRow).Value
      For L = 1 To UBound(TSuj)
         If Not IsEmpty(TSuj(L, 1)) And TÀInv1(L, 1) = Valeur1 Then .Item(TSuj(L, 1)) = Empty
         Next L:
   Else
      TÀInv1 = Intersect(RgÀInv1.EntireColumn, RgSuj.EntireRow).Value
      TÀInv1 = Intersect(RgÀInv2.EntireColumn, RgSuj.EntireRow).Value
      For L = 1 To UBound(TSuj)
         If Not IsEmpty(TSuj(L, 1)) And TÀInv1(L, 1) = Val1 _
            And TÀInv2(L, 1) = Val2 Then .Item(TSuj(L, 1)) = Empty
         Next L: End If
   NbUnique = .Count: End With
End Function

À tester.

 

[KIM]

Re bonjour Dranreb,
Merci pour ton retour. je viens de tester la macro. Elle fonctionne avec l'exemple du fichier joint en changeant Valeur1 par Val1.
Pour saisir la valeur de la condition dans l'appel de fonction j'ai déclaré Val1 et Val2 As String dans la fonction NbUnique et l'appel devient :
FPoint.[E14].Value = NbUnique(FExtrac.[A2], FExtrac.[J2], "Oui").

Avec une condition, la macro fonctionne. Les résultats sont corrects pour :
FPoint.[G9].Value = NbUnique(FRésu.[C2])
FPoint.[E14].Value = NbUnique(FExtrac.[A2], FExtrac.[B2], "BAT GARAG1")
FPoint.[G14].Value = NbUnique(FExtrac.[B2], FExtrac.[J2], "Non")

Par contre, pour 2 conditions Val1 et Val2,
FPoint.[I14].Value = NbUnique(FExtrac.[B2], FExtrac.[J2], "Non", FExtrac.[B2], "BAT GARAG1")
j'ai une erreur :
"l'indice n'appartient pas à la sélection" au niveau de :
If Not IsEmpty(TSuj(L, 1)) And TÀInv1(L, 1) = Val1 _
And TÀInv2(L, 1) = Val2 Then
précisément au niveau de TÀInv2(L, 1)

Merci encore pour ton aide
KIM

 

[Dranreb]

Ah oui j'ai oublié de changer TÀInv1 en TÀInv2 sur la ligne dupliquée au Else