Fichier pour inventaire

**MsVixene** · 14/07/2014, 17h54

Bonjour à tous,

étant débutante en vba, je fais appel à vous.

Après nombreuses recherches et tentatives, voici en PJ un tout petit fichier dans lequel j'aimerais faire un outils de suivi d'inventaire de biens matériels :

J'ai fait deux onglets pour décomposer ma procédure, après si vous avez le temps de me proposer quelque chose de plus light, je suis preneuse.

La procédure actuelle :

On fait un copier de ligne d'un fichier PDF, que l'on vient coller dans l'onglet DONNEES. On voit que les données sont toutes collées à la suite (rouge). C'est la raison pour laquelle j'avais décomposé en 3 colonnes pour extraire les 3 parties. Ensuite je voulais faire un bouton pour copier et coller les formules sur chaque lignes que je viens de coller depuis le PDF. (Je me suis rendu compte que j'ai écrasé les formules en plus mais le résultat que je souhaite est mis dans le classeur)

Deuxième étape sur l'onglet résultat qui fonctionne ; avec un bouton, ramener les données extraites dans l'onglet précédent, et saisir une date d'inventaire et un N° de local. J'ai donc fait ça avec un Userform que j'ai réussi à mettre en route. Ces deux infos saisies se retrouvent donc collées tant de fois que les infos extraites de l'onglet Données sont collées.

Voilà mon petit code est très approximatif et mérite surement quelques corrections MAIS le plus important pour l'instant est que dans l'onglet DONNEES, mon copier coller ne s'arrête pas ?

En espérant avoir été claire.

LIEN FICHIER
(Désolée pour l'hébergement mais je n'ai pas réussi avec le Bouton Gérer les PJ.)

**clementmarcotte** · 14/07/2014, 23h01

Bonjour,

Envoyé par MsVixene

Bonjour à tous,

(Désolée pour l'hébergement mais je n'ai pas réussi avec le Bouton Gérer les PJ.)

C'est peut-être dû à l'extension. Si tu le "compresses" en zip avant de l'envoyer, cela donne quoi ?

Cela ne compresseras pas bien fort, mais zip est accepté, mais, si ma mémoire m'est fidèle, xlsm ne l'est pas.

**Nico Chg** · 15/07/2014, 10h40

Envoyé par MsVixene

Voilà mon petit code est très approximatif et mérite surement quelques corrections MAIS le plus important pour l'instant est que dans l'onglet DONNEES, mon copier coller ne s'arrête pas ?

Bonjour,

C'est egalement mon premier post sur ce forum (qui m'a tout de même beaucoup aider ces dernieres annees)
Si j'ai bien compris, tu as mis des formules dans les colonnes B/C/D/E, et tu veux les etendres par macro jusqu'a la fin de ton tableau ?

Je t'avoue ne pas encore comprendre pourquoi ton copier coller ne s'arrete pas, vu que ta condition est respecter, mais je te propose une autre approche (si je suis a cote de la plaque, dis le moi ^^)

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
47
48
49
 
Function CountLig(Ws As Worksheet, col As Single)
 
'Fonction servant à compter les lignes
 
On Error GoTo ErrorHandler
 
CountLig = Ws.Columns(col).Find("*", , , , xlByRows, xlPrevious).Row
 
Exit Function
 
ErrorHandler:
    CountLig = 1
 
End Function
 
 
Sub CopyFormula()
 
Dim I as single
Dim J as single
Dim LastLine as single
 
Dim MaFormule as string
 
Dim WsDonnee as worksheet
Set WsDonnee = Worksheets("DONNEES")
 
Const FIRSTLINE = 3
 
LastLine = CountLig(WsDonnee, 1)
 
On Error GoTo ErrH
 
For I = 2 to 5           'Boucle sur les colonnes
     MaFormule = WsDonnee.Cells(I, FIRSTLINE).Formula
     For J = FIRTSLINE to LastLine           'Boucle sur les lignes
 
          WsDonnee.Cells(I, J).Formula = MaFormule
 
    Next J
Next I
 
Exit Sub
 
ErrH:
     Err.Raise Err.Number, , Err.Description   'Erreur
 
End sub

Je ne peux pas tester le code actuellement, donc je ne sais pas si il fonctionne
Et si j'ai repondu de travers, dis le moi ^^

Pour l'explication du code :
Je calcule tout d'abord la derniere ligne de ton tableau, avec une fonction CountLig
Puis j'utilise une boucle FOR, qui a pour avantage de ne jamais faire de boucle Infini, vu que l'on definit les limites avant, et pas dynamiquement
Et ensuite, je prend la formule dans la premiere cellule, et je l'applique au cellule du dessous, et je recommence avec les autres colonnes

Cordialement, et bonne chance pour la suite !

**MsVixene** · 15/07/2014, 11h03

Bonjour,

je te remercie d'avoir regardé tout d'abord.

Ensuite j'ai essayé ta maccro mais il semble y avoir un probleme à la ligne 47.

N'y a-t-il pas plus simple sinon ? Ne peut-t-on pas en une fois séparer les données collées et les mettre dans l'onglet RESULTAT ?

(Pour l'hébergement, je ne peux pas le remettre pour l'instant.)

**Nico Chg** · 15/07/2014, 11h18

Il doit y avoir un problème dans le code, et comme je suis un mauvais élève, je bâcle toujours mes gestionnaires d'erreur, ce qui fait que ça plante a la ligne 47.

Si je comprend bien, tu veux prendre les données en rouge sur la feuille DONNEE, les séparer, et les rentrer dans ta feuille résultat en y ajoutant une date et un numéro de Local ?

Bon voila ce que je te propose (J'ai tester le code chez moi, et ça marche)

Ici, j'ai légèrement modifié le code de ton Userform :

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
 
Private mDate As String
Private mLocal As String
 
Property Get TheDate() As String
    'Definit la date en Lecture
    TheDate = mDate
End Property
 
Property Let TheDate(TheDate As String)
    'Definit la date en ecriture
    mDate = TheDate
End Property
 
Property Get LocalNumber() As String
    'Definit le numero de Local en Lecture
    LocalNumber = mLocal
End Property
 
Property Let LocalNumber(LocalNumber As String)
    'Definit le numero de Local en Ecriture
    mLocal = LocalNumber
End Property
 
Private Sub CommandButton1_Click()
 
'Entrer la date et la coller
 
mDate = TextBox1.Value
'Affecte la date entree par l'utilisateur comme une des propriete de l'UF
 
'Entrer le N° de local et le coller
 
mLocal = TextBox2.Value
'Affecte le numero de local entree par l'utilisateur comme une des propriete de l'UF
 
Me.Hide
 
End Sub

J'ai légèrement redéfinis le code de l'Userform pour que rien ne soit écris dans la feuille, mais qu'il me retourne les valeurs "Date" et "Numéro de Local" qu'un Utilisateur aurait rentré.
Si tu as des questions sur les Propriétés de l'Userform, je t'invite a lire ce superbe Tuto qui m'a beaucoup aidé.

Lorsque l'utilisateur appuie sur le bouton "OK", nous affectons les deux valeurs qu'il a rentré dans les propriétés de l'Userform, propriétés auxquelles nous allons pouvoir avoir accès par la suite.

Ensuite, nous allons utiliser un Sub Principal, a l'aide d'une fonction qui va nous permettre de compter les lignes.

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 
Function CountLig(Ws As Worksheet, col As Single)
 
'Fonction servant à compter les lignes
 
On Error GoTo ErrorHandler
 
CountLig = Ws.Columns(col).Find("*", , , , xlByRows, xlPrevious).Row
 
Exit Function
 
ErrorHandler:
    CountLig = 1
 
End Function
 
 
Sub CopyData()
 
Dim I As Single
'Variable d'iteration
Dim LastLine As Single
'Determine la derniere ligne
 
Dim MonMateriel As String
'Determine ton materiel
Dim MySeparateValue() As String
'Tableau separant les donnees issu du PDF
 
Dim AllTheValue() As Variant
'Tableau comprenant toute les valeurs a ecrire
 
Dim WsDonnee As Worksheet
'Feuille de DONNEE
Dim WsResult As Worksheet
'Feuille de Resultat
Set WsDonnee = Worksheets("DONNEES")
Set WsResult = Worksheets("RESULTAT")
 
Const FIRSTLINE = 3
'Determine la premiere ligne de la feuille de DONNEE qui contient des valeurs, a adapter au besoin
 
LastLine = CountLig(WsDonnee, 1)
'Determine la derniere ligne de la feuille de DONNEE
 
Load UserForm1
UserForm1.Show
'Lance l'Userform
 
ReDim AllTheValue(3, LastLine - FIRSTLINE)
'Determine la taille du tableau comprenant toute les valeurs
 
For I = FIRSTLINE To LastLine
'Parcours toutes les donnees issu du PDF
 
    MySeparateValue = Split(WsDonnee.Cells(I, 1), " ")
    'Separe les valeurs selons les espaces
 
    MonMateriel = ""
    For J = LBound(MySeparateValue, 1) + 2 To UBound(MySeparateValue, 1)
        MonMateriel = MonMateriel + MySeparateValue(J) + " "
        'Definit ton materiel comme etant la concatenation de toutes les valeurs issu de la separation
        'sauf les deux premiere
    Next J
 
    AllTheValue(0, I - FIRSTLINE) = UserForm1.TheDate
    'Recupere la propriete Date de l'UF
    AllTheValue(1, I - FIRSTLINE) = UserForm1.LocalNumber
    'Recupere la propriete Numero de Local de l'UF
    AllTheValue(2, I - FIRSTLINE) = MySeparateValue(1)
    AllTheValue(3, I - FIRSTLINE) = MonMateriel
    'Remplie le tableau avec les valeurs que tu veux
 
Next I
 
Unload UserForm1
 
LastLine = CountLig(WsResult, 1) + 1
'Definis la derniere ligne de la feuille Resultat
 
With WsResult
For I = LBound(AllTheValue, 2) To UBound(AllTheValue, 2)
    .Cells(I + LastLine, 1) = AllTheValue(0, I)
    .Cells(I + LastLine, 2) = AllTheValue(1, I)
    .Cells(I + LastLine, 3) = AllTheValue(2, I)
    .Cells(I + LastLine, 4) = AllTheValue(3, I)
    'Remplis ta feuille resultat avec les valeurs du tableau
Next I
.Select
End With
 
End Sub

Grosso modo, nous allons d'abord séparer la chaîne de caractère rouge, pour en tirer le nom du matériel ainsi que son numéro d'inventaire.
Nous écrirons toutes ces valeurs dans une variable de type "Tableau" (A lire également ce magnifique Tuto)

Et ce tableau de résultats est ensuite recopié dans la feuille "RESULTAT"

Pour que tout fonctionne, tu dois simplement lancer la macro "CopyData"

Ci-joint ton fichier avec les macro que j'ai rajouté.
Il faut appuyer sur le bouton de la page "DONNEE" pour lancer la fonction

Voila, si tu as des questions, n’hésite pas.

PS : Je suis sincèrement désolé pour les accents, mais j'utilise actuellement un clavier qwerty, et j'ai un peu de mal avec la transition azerty - qwerty.

**MsVixene** · 15/07/2014, 16h18

Merci beaucoup, j'ai essayé, c'est super.

Petite question : du coup les formules de l'onglet Données sont-elles encore nécessaires ?

**Nico Chg** · 15/07/2014, 16h22

Pas réellement, car dans cet exemple, les données sont directement séparées dans la macro.
Ceci dit, elles peuvent servir à titre d'information, c'est à toi de voir

**MsVixene** · 15/07/2014, 16h27

Ok ben je préfère les enlever parce que j'essaie de rendre la gestion de l'inventaire plus facile pour ma collègue qui va reprendre le sujet, donc autant qu'elle n'ai rien à faire ni à voir d'autre lol

Autre question, je peux donc supprimer les modules 3 et 4 pour ne conserver que le 5 ?

**Nico Chg** · 15/07/2014, 16h33

Et bien je n'ai plus ton fichier en tête, il faut que tu conserve uniquement les Modules ou il y a les macro qui sont utilisés.

**MsVixene** · 15/07/2014, 19h50

Bonsoir,

je ré-ouvre la discussion car je souhaite apporter des modifications à mon fichier.

Afin de faire un récapitulatif de l'avancement de l'inventaire, j'ai fait un onglet POINT A DATE dans lequel on retrouve :

en rouge l'avancement en nombre de locaux et nombre de numéros d'inventaire (dossiers) inventoriés
fond jaune : le nombre de locaux et N°Inventaire ou dossiers à faire
Fond vert : taux d'avancement et taux d'avancement +locaux en cours (=In progress)
Fond orange : nombre de locaux et N°Inventaire restant à inventorier.
Dans cadre noir : les locaux en cours issu de l'userform

Une deuxième source de données vient s'ajouter pour remplir ce récap : il s'agit de l'onglet Extraction qui est issu de SAP et qui n'est pas dans le format souhaité, j'ai donc fait des modifs via une petite maccro, ça c'est ok. (Dans cet onglet, on retrouve que quelques lignes pour vous présenter les cas, mais évidemment j'en ai des centaines)

Comment faire pour que la maccro ne compte que les valeurs uniques en terme de N° de locaux et de N° d'inventaire, ceci depuis les onglets résultats et Extraction, à mettre dans l'onget POINT A DATE ?
Userform : J'aimerais extraire les locaux en cours saisis dans l'userform et les reporter dans le cadre noir de l'onglet POINT A DATE

Encore merci pour votre aide

**Nico Chg** · 16/07/2014, 08h38

Re-Bonjour,

Eh bien pour extraire les valeurs de ton userform, tu peux simplement écrire

Code :

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

Worksheets("LaFeuilleOuTuVeuxEcrireLesDonnees").Cells(x, y).value = Me.TextboxZ.value

Avec X et Y la position de la cellule ou tu veux écrire les données (En chiffre, pour la cellule B2 c'est Cells(2, 2)) et Z le numéro de ta textbox.

Au passage, je te conseille fortement de nommer tes textbox, pour plus de clarté lorsque tu code.
Ce bout de code est à écrire "dans" le bouton OK de ton UF.

Pour ton second problème, as tu déjà penser à un algorithme ?

**MsVixene** · 16/07/2014, 09h29

Je dois répéter la ligne Z fois que j'ai de text box ? Ne puis-je pas insérer un mini tableau de plusieurs lignes et une colonnes ? Vu que toutes les données vont au même endroit.

Pour l'algorythme, je n'y ai pas penser dans la mesure où je ne sais point faire !

**Nico Chg** · 16/07/2014, 09h46

Je veux bien t'aider, mais pas faire tout ton programme non plus

(d'autant plus que j'en ai fait une grosse partie

)

Et bien oui, tu dois répéter cette ligne autant de fois que tu as de Textbox, mais d’après ce que j'en ai vu, tu n'en a que 4, c'est assez rapide, non ?
Sinon, tu peux parcourir toutes les textbox, et sélectionner uniquement celle qui t'intéresse, pour traitement.

Tu peux utiliser ce bout de code pour parcourir tous les contrôles d'un Userform.

Code :

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

1
2
3
4
5
6
7
8
9
10
Dim ObjControl As Object
 
For Each ObjControl In Me.Controls
    If TypeOf ObjControl Is MSForms.Textbox Then                        'Ici on parcours les textbox
        If ObjControl.name = ...                                        'Ici tu met ta condition (J'ai mis un test sur le nom, mais ca peut être n'importe quoi)
            ...
            'Traitement de tes données
        End if
    End If
Next

Et puis pour le second probleme, je pense qu'il est plus simple de partir sur des pistes que tu as expérimenté que de tout réinventer from scratch

**MsVixene** · 16/07/2014, 17h24

Oui chef, merci.

Pour compter les valeurs uniques, voici ce que j'ai trouvé et qui marche et que j'ai commencé à mettre à ma sauce :

Code :

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

1
2
3
4
5
6
7
8
9
Sub compter_uniques()
 Dim UniqueInventaire As New Collection
 On Error Resume Next
 For Each cel In Range("B2:B" & [B65000].End(xlUp).Row)
     UniqueInventaire.Add cel.Value, CStr(cel.Value)
 Next cel
 On Error GoTo 0
 
 End Sub

Seulement à la fin, il y avait une textbox, mais j'aimerais afficher le résultat en G9 de l'onglet POINT A DATE ?

**Nico Chg** · 17/07/2014, 07h50

Bonjour,

Ce bout de code n'est pas mal, bien que je ne puisse garantir sa total réussite, car je n'utilise pas les collections

En gros, tu va remplir une variable collection, qui ne peut pas contenir de doublons car tu rentre une clef (grosso modo, ta clef a la meme valeur que ta valeur)

si il y a une erreur, On Error Resume Next te permet de sauter la ligne ou il y a l'erreur.

Pour limiter un peu ta collection, je te conseille d’utiliser la fonction CountLig, déjà présente dans ton programme, afin de mettre une fin a ta boucle.

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
Sub compter_uniques()
Dim UniqueInventaire As New Collection
Dim LastLine as single
 
LastLine = CountLig(Worksheets("LaFeuilleOuSeTrouveLesDonneesQueTuVeuxRecuperer"), 2)
'Dans cette ligne, le 2 correspond a la colonne B.
'Ce chiffre devra être adapter selon tes besoins
 
On Error Resume Next
For Each cel In Range("B2:B" & Cstr(LastLine))
    UniqueInventaire.Add cel.Value, CStr(cel.Value)
Next cel
On Error GoTo 0
 
End Sub

Avec ce code, tu as une collection de valeur unique. Quelle résultat veut tu afficher ? Si tu veux connaitre le nombre d’élément, tu peux utiliser la méthode Count de ta collection.
Si tu veux une valeur particulière, tu peux utiliser .item(key)

Par exemple, si tu veux le nombre d’élément total de ta collection, il faut que tu fasse

Code :

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

Worksheets("LaFeuilleOuSeTrouveLaCelluleG9").Cells(9, 7).value = UniqueInventaire.Count

Cette ligne doit aller dans le Sub ou est déclarer la macro.

Voila, si tu as d'autre question

**MsVixene** · 22/07/2014, 09h30

Bonjour,

voici ce que j'ai mis mais le résultat est de 2 alors que j'ai 304 lignes uniques qu'il faut compter en colonne C. Les valeurs ont un format nombre mais sont variées. Exemple : 21052; ABH940; TERRR. Voilà les 3 cas.

J'aimerais avoir le nombre de valeurs uniques de la colonne C et de la B, qui n'est pas le même car dans chaque local il y a plusieurs numéros d'inventaire.
Exemple :
Local N° Inventaire
3006 25006
3006 25007
3007 25008

Il faut compter donc 2 locaux et 3 numéros d'inventaire

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
Sub compter_uniques()
Dim UniqueInventaire As New Collection
Dim LastLine As Single
 
LastLine = CountLig(Worksheets("RESULTAT"), 3)
 
On Error Resume Next
For Each cel In Range("C2:B" & CStr(LastLine))
    UniqueInventaire.Add cel.Value, CStr(cel.Value)
Next cel
On Error GoTo 0
 
 Worksheets("POINT A DATE").Cells(9, 7).Value = UniqueInventaire.Count
 
End Sub

**Nico Chg** · 22/07/2014, 11h36

Bonjour,

C'est tout à fait normal que tu obtienne 2, tu compte les item dans la mauvaise feuille !
Il faut également que tu utilise deux collections, sinon tu va compter le nombre de Locaux ET d'inventaire en même temps.

Il faut que tu précises la feuille, je t'ai mis un petit bout de code qui devrais faire ce que tu veux

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
Sub CountUniqueItem()
 
Dim UniqueInventaire As New Collection
Dim UniqueLocal As New Collection
Dim LastLine As Single
 
LastLine = CountLig(Worksheets("RESULTAT"), 2)
'Dans cette ligne, le 2 correspond a la colonne B.
'Ce chiffre devra être adapter selon tes besoins
 
On Error Resume Next
For Each Cel In Worksheets("RESULTAT").Range("B2:B" & CStr(LastLine))
    UniqueLocal.Add Cel.Value, CStr(Cel.Value)
Next Cel
On Error GoTo 0
 
LastLine = CountLig(Worksheets("RESULTAT"), 3)
On Error Resume Next
For Each Cel In Worksheets("RESULTAT").Range("C2:C" & CStr(LastLine))
    UniqueInventaire.Add Cel.Value, CStr(Cel.Value)
Next Cel
On Error GoTo 0
 
Worksheets("POINT A DATE").Cells(9, 5).Value = UniqueLocal.Count
Worksheets("POINT A DATE").Cells(9, 7).Value = UniqueInventaire.Count
 
End Sub

Ici, tu va compter le nombre de Locaux et le nombre d'inventaire en cours, et les écrire dans les cellules E9 et G9, je pense que c'est ce que tu veux faire.

**Marc-L** · 22/07/2014, 12h30

Bonjour,

une collection c'est bien mais utiliser un dictionnaire est bien plus puissant (rapidité & fonctionnalités).
Evite aussi On Error …

Dans l'environnement VBA, taper Dictionary dans la zone de recherche en haut à droite et valider;
plein d'exemples dans les discussions de ce forum …

Pour plusieurs utilisations, mieux vaut créer une fonction :

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
Function NbUnique&(Rg As Range)
               Dim Rc As Range
    If Rg.Count = 1 Then _
        With Rg.Parent: Set Rg = .Range(Rg, .Cells(.Rows.Count, Rg.Column).End(xlUp)): End With
 
    With CreateObject("Scripting.Dictionary")
        For Each Rc In Rg
            If Not .Exists(Rc.Value) Then .Add Rc.Value, ""
        Next
 
        NbUnique = .Count:  .RemoveAll
    End With
End Function
 
 
Sub Demo()
    MsgBox "Local : " & NbUnique(Feuil1.[B2])
    MsgBox "Inventaire : " & NbUnique(Feuil1.[C2])
End Sub

Si seule une cellule est spécifiée en paramètre de la fonction
alors la plage est étendue jusqu'à la dernière saisie de la colonne …

N'oubliez pas le guide :
__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**MsVixene** · 22/07/2014, 14h38

Merci pour vos deux réponses, mais du coup j'utilise pour le moment celle de Nico Chg que j'ai pu appliquer à d'autres.

J'ai une autre question sur le même fichier, j'ai rajouté un onglet A ENLEVER. C'est une liste de N° d'inventaire que j'aimerais ne pas compter dans le compte de l'onglet EXTRACTION et ainsi de les indiquer dans l'extraction en rajoutant une colonne A INVENTORIER, et mettre NON si le numéro d'inventaire est dans la liste A ENLEVER

Jusqu'à maintenant, je faisais manuellement : je mettais une colonne "A inventorier" et ceux dont je ne voulais pas, je mettais NON. Puis filtre etc... Sauf que maintenant, l'onglet EXTRACTION est régulièrement extrait de SAP...

J'aimerais faire la même chose qu'une requête SQL qui a été créée et qui se base sur une liste :
Exemple:
EAUX ---------> Ma formule de rechercheV va fonctionner puisque le N° d'inventaire est identique.
EBAT% -------> Pour les N° avec % la requête fait en sorte de ne pas compter les N° commençant par EBAT par exemple ici.

Du coup, j'ai commencé une maccro avec l'assistant mais bon vous comprenez bien que ça ne fonctionne pas avec les N° terminant par % de la liste A ENLEVER

:

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
Sub Extraction()
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "A INVENTORIER"
    Range("J2").Select
    Columns("I:I").Select
    Selection.Copy
    Columns("J:J").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("J:J").EntireColumn.AutoFit
    Application.CutCopyMode = False
    Range("J2").Select
    ActiveCell.FormulaR1C1 = _
        "=si(EXTRACTION!B2=recherchev(B2;'A enlever'!A:A;1;faux);""NON"";"""")"
    Range("J2").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = _
        "=IF(EXTRACTION!RC[-8]=VLOOKUP(RC[-8],'A enlever'!C[-9],1,FALSE),""NON"","""")"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J17818")
    Range("J2:J17818").Select
End Sub

**Nico Chg** · 22/07/2014, 14h54

Je pense que tu devrais également utiliser la solution de Marc-L, qui est bien plus "propre" que celle que j'ai posté.

Nom : Capture.JPG
Affichages : 1807
Taille : 87,6 Ko

Nom : Capture.JPG
Affichages : 1807
Taille : 87,6 Ko

Il faut que tu active cette référence de mémoire : Microsoft Scripting Runtime

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
Function NbUnique&(Rg As Range)
               Dim Rc As Range
    If Rg.Count = 1 Then _
        With Rg.Parent: Set Rg = .Range(Rg, .Cells(.Rows.Count, Rg.Column).End(xlUp)): End With
 
    With CreateObject("Scripting.Dictionary")
        For Each Rc In Rg
            If Not .Exists(Rc.Value) Then .Add Rc.Value, ""
        Next
 
        NbUnique = .Count:  .RemoveAll
    End With
End Function
 
 
Sub CountUniqueItem()
 
Dim RgInventaire As Range
Dim RgLocal As Range
Dim LastLine As Single
 
LastLine = CountLig(Worksheets("RESULTAT"), 3) 
Set RgInventaire = Worksheets("RESULTAT").Range("C2:C" & CStr(LastLine))
 
LastLine = CountLig(Worksheets("RESULTAT"), 2)
Set RgLocal = Worksheets("RESULTAT").Range("B2:B" & CStr(LastLine))
 
Worksheets("POINT A DATE").Cells(9, 5).Value = NbUnique(RgLocal)
Worksheets("POINT A DATE").Cells(9, 7).Value = NbUnique(RgInventaire)
 
End Sub

Je n'ai pas du tout tester, mais ça devrait marcher, et c'est "plus propre" que le code que je t'ai donné.

Fichier pour inventaire [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager