Comment faire un compteur en VBA Excel

Version imprimable

03/10/2009, 20h25
pmoge

1 pièce(s) jointe(s)

Comment faire un compteur en VBA Excel

Bonjour,
Est-ce que il y’a qlqun qui peut m’aider un faire un petit programme en Vab Excel qui contient un compteur qui peut me compter le nombre de dossiers par mode de transport a partir de feuille1 a feuille 2
Voir format voulue sur feuille2 dans le fichier ci-joint
03/10/2009, 20h31
Invité

Bonjour et bienvenue sur le forum Office de DVP.

Beaucoup de membres du forum ne téléchargent pas les pièces jointes (pour des raisons de sécurité ou de connexion), c'est pour cela qu'il est aussi intéressant de détailler clairement son problème.

Philippe

Ca pourrait ressembler à ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub calcul()
 Dim ligne As Long, lignemax As Long, mois As Long, transport As Long
 
 Sheets("Feuil2").Range("B4:D16").ClearContents
 Sheets("Feuil1").Activate
 lignemax = Selection.SpecialCells(xlCellTypeLastCell).Row
 
 For ligne = 2 To lignemax
  If Sheets("Feuil1").Cells(ligne, 1) <> "" Then
   mois = Format$(Sheets("Feuil1").Cells(ligne, 1), "m")
   t = Sheets("Feuil1").Cells(ligne, 8)
   For transport = 2 To 4
    If t = Sheets("Feuil2").Cells(3, transport) Then Exit For
   Next transport
   Sheets("Feuil2").Cells(3 + mois, transport) = Sheets("Feuil2").Cells(3 + mois, transport) + 1
  End If
 Next ligne
 Sheets("Feuil2").Activate
 
End Sub

Il suffit de créer un bouton sur la feuille "Feuil2" qui pointe sur calcul

04/10/2009, 13h17
laetitia

bonjour pmoge Philippe helas le forum
dans ton cas pourquoi passer par vba ???? par formule plus simple
ex: avec sommeprod

feuille2 cellule b4

Code:

=SOMMEPROD((Feuil1!$A$2:$A$10000="01/01/2009"*1)*(Feuil1!$H$2:$H$10000="DHL"))

tu etires la formule jusqu'a b15 & tu modifies
idem pour les autres cellules tu modifies seulement adresse & condition

tu remarques que janv.09 je l'écris "01/01/2009"*1
donc => févr.-09 = "01/02/2009"*1
04/10/2009, 16h21
pmoge

Bonjour Helas,
je vous remercie pour votre solution;néanemoins, ca me done la meme resultat qu'avec le tableau croisé dynamique ou someprode.Ca me compte les doublons des dossiers toujours ; est ce que c'est possible de ne pas compter les doublons.
Est ce que c'est possible aussi d'aficher le nombre des dossiers qui sont payé et ceux qui n'on pas??

je vous remerci beacoup pour votre aide
04/10/2009, 16h42
Pierre Fauconnier

Bonjour

Il faut d'abord expliquer ce que tu souhaites obtenir, au départ de quelles données...

Tu parles de doublons. Si je regarde ton tableau, je vois effectivement des données en double, lorsque je regarde une colonne à la fois. Par contre, sur l'ensemble des colonnes, je n'ai pas de lignes en double.

La finalité d'un tableau croisé dynamique étant de regrouper des données sur certaines valeurs, éliminer les doublons revient à ne plus avoir besoin du TCD car, si pas de valeurs en double, en triple, ... Pas de possibilité de regrouper (plus logique que cela, tu meurs).

Donc, la question est:
Sur base du tableau que tu donnes, que souhaites-tu obtenir?
04/10/2009, 16h55
Invité

Bonjour,

Est-ce que votre tableau peut être trié sans inconvénient ?

Sinon, une des possibilités : incrémenter une liste de N° séquentiels dans la 1ère colonne vide ("L" par exemple) puis trier sur le mois et le mode de transport puis exécuter la boucle puis trier sur la colonne "L" et supprimer le contenu de cette colonne.

Tout cela fait en VBA bien sûr.
04/10/2009, 18h52
laetitia

rebonjour le fil on peut le faire aussi avec sommeprod pour les doublons

exemple

Code:

=SOMMEPROD(((Feuil1!$A$2:$A$10000="01/01/2009"*1)*(Feuil1!$H$2:$H$10000="DHL")*(EQUIV(Feuil1!$I$2:$I$10000;Feuil1!$I$2:$I$10000;0)=LIGNE(Feuil1!$I$2:$I$10000))))

a tester!!!
07/10/2009, 18h09
pmoge

Bonjour,

je vous remercie pour votre aide; mais ca marche pas toujours;en + avec someprode le PC n'arrete pas a calculer et se bloque aussi; est ce que vous pouvez m'aider a faire avec vba, sur le programme fait par Helas j'ai un problem que avec les doublons sinon samache bien. est ce que vous pouvez le faire sans qu'il compte les doublons

merci d'avance
07/10/2009, 18h26
laetitia

bonjour le fil le forum comme dit PIERRE quel doublons la reference , facture ect....soit plus explicite
07/10/2009, 18h31
Pierre Fauconnier

Un tcd fonctionne très bien pour cela

http://fauconnier.developpez.com/for...transports.png

Si tu veux vraiment ton tableau en feuil2, tu peux:
- nommer la plage de données
- l'utiliser dans la formule suivante

Code:

=SOMMEPROD((MOIS(DECALER(Données;0;0;;1))=MOIS($A4))*(DECALER(Données;0;7;;1)=B$3))

ce qui donne le tableau suivant
http://fauconnier.developpez.com/for...ortdecaler.png

Mais avec SOMMEPROD, tu vas ramer sur beaucoup de lignes
07/10/2009, 18h40
pmoge

en effet, je veux faire la somme du numero des dossiers colonne (I) sur la premiere feuille, fichier attaché a mon premier message.
le numero d'un seul dossier peut se repeter 20 fois dans la colonne (I) et je veux le compter une seul fois tout simplement
je veux avoir le resultat suivant: nombre de dossiers par mode de transport

Mois nbr dossiers DHL nbr dossiers avion

Jan 05 06
Fév 02 05
Mars 03 09

je vous remercie

même avec le tcd ca ne marche pas aussi; il compte sur le mois de janv 9 dossiers avion alors que il y 'a que deux numero qui se repetes le TAF0028/09 et le TAF0031/09

donc mois je veux sur le tableau que 2 pas 9 ; je ne sais pas si c'est possible.

je vous remercie beaucoup pour votre aide.

Pmoge
07/10/2009, 19h05
Pierre Fauconnier

Si tu peux ajouter une colonne

1) Nommer la plage des données avec la formule

Code:

=DECALER(Feuil1!$A$1;1;0;NBVAL(Feuil1!$A:$A)-1;NBVAL(Feuil1!$1:$1))

2) En L2, tu saisis

Code:

=1/SOMMEPROD((MOIS(DECALER(Données;0;0;;1))=MOIS(A2))*(DECALER(Données;0;7;;1)=H2)*(DECALER(Données;0;8;;1)=I2))

et tu tires vers le bas

3) En L1, tu saisis "Nombre" ou tout autre libellé qui te parle

4) Tu ajoutes ce champ dans les données de ton tcd, avec une synthèse par somme...

Si tu veux toujours ton tableau en feuille 2, tu utilises la même colonne ajoutée, et tu saisis la formule suivante en B4 de feuil2, puis tu copies sur ton tableau

Code:

=SOMMEPROD((MOIS(DECALER(Données;0;0;;1))=MOIS($A4))*(DECALER(Données;0;7;;1)=B$3)*(DECALER(Données;0;11;;1)))

MAIS! Sauf erreur, les valeurs que tu donnes dans ton précédent message ne correspondent pas au fichier que tu as donné dans ton premier message...

re, comme j' ai cru conprendre c'est vraiment pas sûr !!!en reprenant le code de helas en cherchant d'abord les doublons code vraiment brut de chez brute !!!!!!

Code:

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
Sub helas()
Dim Cel As Range, M As Object, Rng As Range, MaLigne, L As Long, li As Long
Dim ligne As Long, lignemax As Long, mois As Long, transport As Long
 Application.ScreenUpdating = False
  Sheets("Feuil1").Activate
  L = Range("A65536").End(xlUp).Row
  Set M = CreateObject("Scripting.Dictionary")
  For Each Cel In Range("a1:a" & Range("a65536").End(xlUp).Row)
 MaLigne = Cel & Cel.Offset(0, 8)
  If Not M.Exists(MaLigne) Then
  M.Add MaLigne, MaLigne
     Else
      Cel.Offset(0, 8).Interior.ColorIndex = 8
     If Cel.Offset(0, 7) = "DHL" Then z = z + 1
     End If
    Next Cel
Sheets("Feuil2").Range("B4:D16").ClearContents
 Sheets("Feuil1").Activate
 lignemax = Selection.SpecialCells(xlCellTypeLastCell).Row
  For ligne = 2 To lignemax
  If Cells(ligne, 1) <> "" And Cells(ligne, 9).Interior.ColorIndex <> 8 Then
   mois = Format$(Sheets("Feuil1").Cells(ligne, 1), "m")
   t = Sheets("Feuil1").Cells(ligne, 8)
   For transport = 2 To 4
    If t = Sheets("Feuil2").Cells(3, transport) Then Exit For
   Next transport
   Sheets("Feuil2").Cells(3 + mois, transport) = Sheets("Feuil2").Cells(3 + mois, transport) + 1
  End If
 Next ligne
 Sheets("Feuil2").Activate
End Sub

07/10/2009, 23h43
pmoge

Rebonjour,
c'est tres gentille de votre part laetitia;j'aprecie votre cooperation je vous remercie pour tous ca , mais toujours il me sort le mauvais resulat , je pense bien que vous pouvez m'aider a le faire a la fin .le code de Helas marche bien sauf qu'il me compte le numéro du dossier a chaque fois il le trouve ;mais il compte juste ,si un numero du dossier apparesse 2 fois+ un autre numero d'un autre dossier apparesse 1 fois il me donne resultat 3; mais mois je veux c'est un numero du dossier apparesse 20 fois il le compte qu'une seul fois .

Je te propose une fonction personnalisée, à utiliser dans la feuille 2 de ton classeur.

Point de vue de la conception de ton tableau en feuil2, j'ai changé les valeurs des mois pour saisir des dates (01/01/09, 01/02/09, ...) avec format d'affichage à "mmmm". C'est plus pratique, pour comparer des dates, d'avoir des dates et des dates, et non des dates et du texte.

Voici la fonction perso

Code:

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
Function CompterDossiersMoisTransport(Plage As Range, Mois As Integer, TypeTransport As String) As Long
    Dim dictionnaire As Object
    Dim Cellule As Range
    Dim ColDates As Integer
    Dim ColTypesTransport As Integer
    Dim ColDossiers As Integer
    Dim Compteur As Long
 
    ColDates = 1 ' Dates en A
    ColTypesTransport = 8 ' Types de transport en H
    ColDossiers = 9 ' Dossiers en I
    ' On peut aussi passer ces valeurs en paramètres
 
    Set dictionnaire = CreateObject("scripting.dictionary")
    For Each Cellule In Plage.Columns(1).Cells
        If Month(Cellule(1, ColDates)) = Mois And Cellule(1, ColTypesTransport) = TypeTransport Then
                If Not dictionnaire.exists(Cellule(1, ColDossiers).Value) Then
                    dictionnaire.Add Cellule(1, ColDossiers).Value, ""
                    Compteur = Compteur + 1
                End If
        End If
    Next Cellule
    CompterDossiersMoisTransport = Compteur
    Set dictionnaire = Nothing
End Function

Tu l'utilise, par exemple en B4, comme ceci, sur base de ton fichier exemple:

Code:

=CompterDossiersMoisTransport(Feuil1!$A$2:$K$33;MOIS(Feuil2!$A4);Feuil2!B$3)

Ma proposition est lourde:

Code:

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
Option Explicit
 
Private Sub CommandButton1_Click()
Dim LastLig As Long, i As Long
Dim cel As Range, c As Range, r As Range
Dim kod As Collection, moi As Collection, tran As Collection
 
Application.ScreenUpdating = False
 
With Sheets("Feuil1")
                                                    'Ajout d'une colonne Date & Dossier & Mode transp
    LastLig = .Range("A65536").End(xlUp).Row
    For i = 2 To LastLig
        .Range("L" & i).Value = .Range("A" & i).Value & .Range("I" & i).Value & .Range("H" & i).Value
    Next i
 
    Set kod = New Collection                        'Valeurs sans doublons de la nouvelle colonne
    On Error Resume Next
    For Each cel In .Range("L2:L" & LastLig)
        If cel <> "" Then kod.Add cel, CStr(cel)
    Next cel
    On Error GoTo 0
 
    Set moi = New Collection                        'Valeurs sans doublons des dates (mois)
    On Error Resume Next
    For Each cel In .Range("A2:A" & LastLig)
        If cel <> "" Then moi.Add cel, CStr(cel)
    Next cel
    On Error GoTo 0
 
    Set tran = New Collection                        'Valeurs sans doublons des modes de transport
    On Error Resume Next
    For Each cel In .Range("H2:H" & LastLig)
        If cel <> "" Then tran.Add cel, CStr(cel)
    Next cel
    On Error GoTo 0
End With
 
With Sheets("Feuil2")
    .Cells.ClearContents
    For i = 1 To moi.Count                              'Titres de lignes
        .Cells(i + 1, 1).Value = CDate(moi.Item(i))
    Next i
 
    For i = 1 To tran.Count                             'Titres de colonnes
        .Cells(1, i + 1).Value = tran.Item(i)
    Next i
 
    For i = 1 To kod.Count                              'Intersection
        Set c = .Range("A2:A" & .Range("A65536").End(xlUp).Row).Find(CDate(Left(kod.Item(i), 10)), LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Set r = .Range(.Cells(1, 2), .Cells(1, .Range("IV1").End(xlToRight).Column)).Find(Mid(kod.Item(i), 21, Len(kod.Item(i)) - 20), LookIn:=xlValues, LookAt:=xlWhole)
                If Not r Is Nothing Then .Cells(c.Row, r.Column) = .Cells(c.Row, r.Column) + 1
        End If
        Set c = Nothing: Set r = Nothing
    Next i
End With
Set kod = Nothing
Set moi = Nothing
Set tran = Nothing
Sheets("Feuil1").Columns("L:L").ClearContents
Application.ScreenUpdating = True
End Sub

11/10/2009, 16h35
pmoge

Impeccable!!!! Maintenant ça marche bien avec la proposition de mercatog; il me compte juste et sans doublons; je vous remercie tous pour votre aide.
24/01/2019, 15h30
OAUGADOUGOU

SOS

Bonjour ,
je viens de voir que votre problème a été solutionné .
en faite ,'ai a peu près la mémé doléance que vous.
j'aimerais avoir un fichier excel ou je pourrais mentionner
la date de commande
le nom du client
type de commande
le nombre de commande similaire
le moyen de livraison
le prix de livraison
le poids de la commande
les délais de réception
les lieux de réception

merci bien