compter le nombre d'arguments

Version imprimable

05/12/2009, 12h11
djoumusic

compter le nombre d'arguments

Bonjour,
j'aimerai pouvoir compter le nombre d'argument dans une cellule excel..
du type (+12+12+14) donnerai le resultat de 3 puisque 3 chiffres sont additionés..
et ensuite pouvoir avoir comme données : nombre de 12 2,
nombre de 14 1
puisque le chiffre 12 est utilisé 2 fois et le chiffre 14 une seule fois..

est ce possible,
vers quel fonction, il faut que j'aille...
merci enormement..

Julien
05/12/2009, 16h45
Didier Gonard

Bonjour,

Dans l'éditeur vba, tu fais affichage, Explorateur d'objets, dans la colonne Classes, tu descend pour cliquer sur Strings, dans les membres de strings tu as tout ce qu'il faut, tu surlignes un élément et tu appuies sur F1 => l'aide jaillit.

vois en particulier InStr et InStrRev, Len, Mid , right left.

tu auras peut-être intérêt à te construire des fonctions à partir de ça, il y tout ce qu'il faut dans les tutos Excel du forum ;)

Il existe peut-être des fonctions natives plus proches, mais ça ne me vient pas à l'esprit..

cordialement,

Didier

Bonsoir

Un exemple de code pour compter le nombre de valeurs numériques.

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
 
Function compter(cellule_avec_valeur As Range)
If cellule_avec_valeur = "" Then
    compter = 0
    Exit Function
End If
Dim i As Integer
Dim i1 As Byte
Dim premier As Boolean
Dim suivant As Boolean
Dim val1 As String
 
val1 = CStr(cellule_avec_valeur.Value)
For i = 1 To Len(CStr(cellule_avec_valeur.Value))
    ' on recherche la première position
    If IsNumeric(Mid(val1, i, 1)) Then
    ElseIf premier = True Then ' la valeur n'est pas numérique
        i1 = i1 + 1
        premier = False
        suivant = True ' pour sauter le test suivant
    End If
 
    If IsNumeric(Mid(val1, i, 1)) And premier = False And premier = False Then premier = True
 
    suivant = False
Next i
If premier = True Then i1 = i1 + 1
compter = i1
End Function

A tester

JP014

05/12/2009, 18h10
Didier Gonard

Bonjour,

Selon le contexte exact de djoumusic, perso, je me baserai plus sur la détection de ses séparateurs (le + dans son exemple, mais ça peut varier) pour isoler ce qu'il y a entre les deux (d'où InStr)...

Si, ce qui n'est pas précisé ici, il y a un nombre à virgule, ta fonction jp014 va décompter un item de plus etc...

cordialement,

Didier

combien d'arguments donnera 4.5+6.12 ?

ma proposition pour trouver le nombre d'arguments

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function NbNum(Rng As Range) As Integer
Dim Tablo, Sign, Contenu
Dim i As Byte
Sign = Array("=", "+", "-", "*", "/")
Contenu = CStr(Rng.Formula)
If IsNumeric(Left(Contenu, 1)) Then NbNum = 1
For i = 0 To UBound(Sign)
    If InStr(Contenu, Sign(i)) > 0 Then
        Tablo = Split(Contenu, Sign(i))
        NbNum = NbNum + UBound(Tablo)
    End If
Next i
End Function

05/12/2009, 19h05
jp014

Bonsoir

Citation:

Envoyé par Ormonth

Bonjour,

Selon le contexte exact de djoumusic, perso, je me baserai plus sur la détection de ses séparateurs (le + dans son exemple, mais ça peut varier) pour isoler ce qu'il y a entre les deux (d'où InStr)...

Si, ce qui n'est pas précisé ici, il y a un nombre à virgule, ta fonction jp014 va décompter un item de plus etc...

cordialement,

Didier

Le problème est de savoir si une virgule est un séparateur de valeur ou si elle fait partie de la valeur numérique.

Bon Week end
JP
05/12/2009, 21h37
djoumusic

merci a vous gtous,
je vais essayer vos exemples..
les chiffres a virgules, ne represente qu'un nombre..
2,65 = 1

cdt

le message et surtout le code de mercatog, est le bon...
c'est super !
il ne me manque plus qu'a detailler l'interieur de ma celle...
j'entend par là
pour voir dire si dans ma cellule le calcul est +9+9+6+6+3
que j'ai
nombre de 9 = 2
nombre de 6 = 2
nombre de 3 = 1

vous avez une idée ??

Bonjour le fil

Ci ,dessous une fonction qui compte le nombre de valeur numérique (y compris avec virgule), puis indique dans un message le nombre de valeurs identiques. Le type de séparateur n'a pas d'importance.

La fonction utilise la notion de front montant, c'est à dire le passage de valeur logique "false" à la valeur logique "true".
Dans la première partie on détermine le nombre de valeur.
Dans la deuxième partie on utilise un tableau pour mémoriser et compter les valeurs identiques.

A

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
Function compter(cellule_avec_valeur As Range)
If cellule_avec_valeur = "" Then
    compter = 0
    Exit Function
End If
Dim i As Integer
Dim i1 As Byte
Dim numerique As Boolean, trouve As Boolean
Dim frontmontant As Boolean
Dim frontdescend As Boolean, avantnumerique As Boolean
Dim tabl() As Variant
Dim nbc() As Byte
Dim val1 As String
Dim val2 As Variant
Dim j As Byte
 
val1 = CStr(cellule_avec_valeur.Value) & "£"
For i = 1 To Len(val1)
    ' on recherche la première position
    If IsNumeric(Mid(val1, i, 1)) Or Mid(val1, i, 1) = "," Then
        numerique = True
    Else
        numerique = False
    End If
    If numerique = True And avantnumerique = False Then
        frontmontant = True
    Else
        frontmontant = False
    End If
        avantnumerique = numerique
 
    If frontmontant = True Then i1 = i1 + 1
Next i
 
compter = i1
ReDim tabl(1 To i1)
ReDim nbc(1 To i1)
j = 1
For i = 1 To Len(val1)
    ' on recherche la première position
    If IsNumeric(Mid(val1, i, 1)) Or Mid(val1, i, 1) = "," Then
        numerique = True
    Else
        numerique = False
    End If
 
    If numerique = False And avantnumerique = True Then
        frontdescend = True ' apparition d'une valeur
    Else
        frontdescend = False
    End If
 
   avantnumerique = numerique
 
    If numerique Then val2 = val2 & Mid(val1, i, 1)
 
    If frontdescend = True Then ' le nombre est fini
        If j > 1 Then
            trouve = False
            For i1 = LBound(tabl()) To j
                If tabl(i1) = val2 Then
                    nbc(i1) = nbc(i1) + 1
                    trouve = True
                    Exit For
                End If
            Next i1
            If trouve = False Then
                tabl(j) = val2
                nbc(j) = 1
                j = j + 1
            End If
        Else
            tabl(j) = val2
            nbc(j) = 1
            j = j + 1
        End If
        val2 = ""
    End If
 
 
Next i
For i = 1 To j -1
MsgBox ("le nombre :  " & tabl(i) & " a été trouvé  " & nbc(i) & " fois")
Next i
End Function

A tester

JP

Sur le même principe (légèrement modifié)! à adapter le résultat

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
Public Function DispArg(Rng As Range) As String
Dim Tablo, Sign, Contenu, ArguFreq(), TempTab
Dim i As Byte, j As Byte, k As Byte
 
Sign = Array("=","+", "-", "*", "/")
Contenu = CStr(Rng.Formula)
For i = 0 To UBound(Sign)
    Contenu = Replace(Contenu, Sign(i), "µ")
Next i
Do
If Left(Contenu, 1) = "µ" Then Contenu = Mid(Contenu, 2)
Loop Until IsNumeric(Left(Contenu, 1))
Tablo = Split(Contenu, "µ")   'Séparation des arguments
 
For i = 0 To UBound(Tablo)      'Tri du tablo arguments
    For j = 0 To UBound(Tablo)
        If CDbl(Tablo(i)) < CDbl(Tablo(j)) Then
            TempTab = Tablo(i)
            Tablo(i) = Tablo(j)
            Tablo(j) = TempTab
        End If
    Next j
Next i
 
j = 0: k = 0            'Recupération des arguments avec leur fréquence
Do
    ReDim Preserve ArguFreq(2, k)
    ArguFreq(0, k) = Tablo(j)
    i = 1: j = j + 1
    Do While j <= UBound(Tablo)
        If UBound(Tablo) > 0 Then
            If Tablo(j) = ArguFreq(0, k) Then
                j = j + 1
                i = i + 1
            Else
                Exit Do
            End If
        End If
    Loop
    ArguFreq(1, k) = i
    k = k + 1
Loop Until j = UBound(Tablo) + 1
 
 
For i = 0 To UBound(ArguFreq, 2)
    DispArg = DispArg & "(" & ArguFreq(0, i) & "," & ArguFreq(1, i) & ")"
Next i
End Function

En A1 la formule
en B1: =DispArg(A1) donne un string contenant les arguments avec leurs fréquences! à adapter

En utilisant une collection

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
Public Function DispArg(Rng As Range) As String
Dim Tablo, Sign, Contenu, ArguFreq()
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
Sign = Array("=","+", "-", "*", "/")
Contenu = CStr(Rng.Formula)
For i = 0 To UBound(Sign)
    Contenu = Replace(Contenu, Sign(i), "µ")
Next i
Do
If Left(Contenu, 1) = "µ" Then Contenu = Mid(Contenu, 2)
Loop Until IsNumeric(Left(Contenu, 1))
Tablo = Split(Contenu, "µ")
 
Set TempTab = New Collection
    On Error Resume Next
    For i = 0 To UBound(Tablo)
        TempTab.Add Tablo(i), Tablo(i)
    Next i
 
    ReDim ArguFreq(0 To 1, 0 To TempTab.Count - 1)
    For i = 1 To TempTab.Count
        ArguFreq(0, i - 1) = TempTab.Item(i)
    Next i
 
    For i = 0 To TempTab.Count - 1
        For j = 0 To UBound(Tablo)
            If CDbl(ArguFreq(0, i)) = CDbl(Tablo(j)) Then ArguFreq(1, i) = ArguFreq(1, i) + 1
        Next j
    Next i
Set TempTab = Nothing
 
For i = 0 To UBound(ArguFreq, 2)
    DispArg = DispArg & "(" & ArguFreq(0, i) & "," & ArguFreq(1, i) & ")"
Next i
End Function

L'appel est de la même manière que le code précédent

bonjour djoumusic jp014 l'ami mercatog le forum
une version macro
exemple en cellule a1
(9+9-6+6-5+30+30+10-10.5)
resultat en colonne c & d

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
Sub test()
 Dim a, b, e, c, compteur As Variant, m As Object
  a = 2: b = Replace([a1], ".", ",")
        For compteur = 1 To Len(b)
        e = Mid(b, compteur, 1)
        Select Case e
         Case Is = "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ","
         Cells(a, 2).Value = Cells(a, 2).Value & e
          Case Else
        If Cells(a, 2).Value = "" Then Debug.Print Else: a = a + 1
       End Select
     Next
Set m = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
m(c.Value) = IIf(m.Exists(c.Value), m(c.Value) + 1, 1)
Next c
Range("b2:b20").ClearContents
[b2].Resize(m.Count, 1) = Application.Transpose(m.keys)
[c2].Resize(m.Count, 1) = Application.Transpose(m.items)
End Sub

Le code amélioré, en tenant compte des chaines vides ou valeurs nom numériques

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
Public Function DispArg(Rng As Range) As String
Dim Tablo, Sign, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
Sign = Array("=", "+", "-", "*", "/")
Contenu = CStr(Rng.Formula)
For i = 0 To UBound(Sign)
    Contenu = Replace(Contenu, Sign(i), " ")
Next i
 
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Trim(Contenu), " ")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            If IsNumeric(Tablo(i)) Then TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
 
    For i = 0 To UBound(ArguFreq, 1)
        DispArg = DispArg & "(" & ArguFreq(i, 0) & "," & ArguFreq(i, 1) & ")"
    Next i
End If
End Function

dans A1: =12.5/34+2-34*5-12.5/2+34
dans B1:=DispArg(A1) donne: (12.5,2)(34,3)(2,2)(5,1)

07/12/2009, 23h02
djoumusic

Cest pas mal tous ces exemples...

cependant, ca rentre pas dans mon besoin,
j'utilise une cellule pour faire du comptage de ticket restaurant..
et j'ai besoin pour les versements, de detailler, combien de ticket a 6,5 ou à different montant..

c'est pour ça que +6+6+8,5+8,5+3,12+3,12
doit me donner sur 2 colonne
6-----2
8,5---2
3,12--2

Tu as toujours des +?
le code que j'ai proposé (général) peut être alors simplifié
il ne permet pas de te donner ce que tu veux?

le tableau ArguFreq(k, 0) donne le k ième montant et ArguFreq(k,1) donne la fréquence de ce montant!

Après simplification (selon ton dernier message)
Ta formule en A2
en colonne B seront reporté les montants
en colonne C, les fréquences
en D les totaux
à l'aide d'un CommandButton sur la feuille

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
Option Explicit
 
Private Sub CommandButton1_Click()
Dim Rng As Range
Dim Tablo, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
Set Rng = Range("A2")
Contenu = Replace(Rng.Formula, "=", "")
 
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Contenu, "+")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
    Columns("B:C").ClearContents
    For i = 0 To UBound(ArguFreq, 1)
        Range("B" & i + 2).Value = ArguFreq(i, 0)
        Range("C" & i + 2).Value = ArguFreq(i, 1)
        Range("D" & i + 2).Value = Range("B" & i + 2).Value * Range("C" & i + 2).Value
    Next i
    Range("D" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
End If
Set Rng = Nothing
End Sub

Bonjour

Ci dessous une procédure évènementielle qui inscrit le résultat sur la ligne qui contient les données.
Les lignes à utiliser sont 3,7,...
Si le résultat doit être affichée en colonnes il faut supprimer (ou remplacer ) les lignes indiquées.

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
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Option Explicit
Dim flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim data1 As String, val1 As String
Dim cellule As Range
Dim dl1 As Long ' dernière ligne
Dim i As Integer
Dim numerique As Boolean, trouve As Boolean
Dim frontdescend As Boolean, avantnumerique As Boolean, frontmontant As Boolean
Dim tabl() As Variant, val2 As Variant
Dim nbc() As Byte, j As Byte, i1 As Byte
 
 
 
 
If flag = True Then Exit Sub
If Target.Count > 1 Then Exit Sub
i = (Target.Row + 1) Mod 4 ' à supprimer si le résultats en colonne
If i <> 0 Then Exit Sub ' à supprimer si le résultats en colonne
If Target = "" Then Exit Sub
With Sheets(Target.Worksheet.Name)
dl1 = .Range("a65536").End(xlUp).Row ' à supprimer
 
If Not Intersect(Target, Range("a1:a" & dl1)) Is Nothing Then ' a supprimer et remplacer par la ligne suivante
'If Not Intersect(Target, Range("a2:a" & 2)) Is Nothing Then
flag = True
 
.Range("B" & Target.Row & ":CA" & Target.Row + 2).ClearContents 'a supprimer et remplacer par la ligne suivante
'.Range("B2:C1000").ClearContents
 
 
 
 
val1 = CStr(Target.Value) & "£"
    For i = 1 To Len(val1)
        ' on recherche la première position
        If IsNumeric(Mid(val1, i, 1)) Or Mid(val1, i, 1) = "," Then
            numerique = True
        Else
            numerique = False
        End If
        If numerique = True And avantnumerique = False Then
            frontmontant = True
        Else
            frontmontant = False
        End If
            avantnumerique = numerique
 
        If frontmontant = True Then i1 = i1 + 1
    Next i
 
Target.Offset(0, 1) = i1
 
ReDim tabl(1 To i1)
ReDim nbc(1 To i1)
j = 1
    For i = 1 To Len(val1)
        ' on recherche la première position
        If IsNumeric(Mid(val1, i, 1)) Or Mid(val1, i, 1) = "," Then
            numerique = True
        Else
            numerique = False
        End If
 
        If numerique = False And avantnumerique = True Then
            frontdescend = True ' apparition d'une valeur
        Else
            frontdescend = False
        End If
 
       avantnumerique = numerique
 
        If numerique Then val2 = val2 & Mid(val1, i, 1)
 
        If frontdescend = True Then ' le nombre est fini
            If j > 1 Then
                trouve = False
                For i1 = LBound(tabl()) To j
                    If tabl(i1) = val2 Then
                        nbc(i1) = nbc(i1) + 1
                        trouve = True
                        Exit For
                    End If
                Next i1
                If trouve = False Then
                    tabl(j) = val2
                    nbc(j) = 1
                    j = j + 1
                End If
            Else
                tabl(j) = val2
                nbc(j) = 1
                j = j + 1
            End If
            val2 = ""
        End If
 
 
    Next i
 
    For i = 1 To j
        If nbc(i) > 0 Then
            Target.Offset(0, i + 1).Value = Replace(tabl(i), ",", ".")
            Target.Offset(1, i + 1).Value = nbc(i)
            Target.Offset(2, i + 1) = tabl(i) * nbc(i)
            ' si colonnes au lieu de lignes supprimer les 3 lignes ci dessus
            'Target.Offset(i+1,1).Value = Replace(tabl(i), ",", ".")
            'Target.Offset(i+1, 2).Value = nbc(i)
            'Target.Offset(i+1, 3) = tabl(i) * nbc(i)
 
        End If
 
    Next i
End If
 
End With
flag = False
End Sub

A tester

JP014

09/12/2009, 14h41
djoumusic

Mercatog,
je ne vais avoir que des "+" dans mes cellules,

mais ta fonction,
je n'arrive pas a l'appeller.. j'ecris bien =DispArgu(A1),
je n'ai rien qui s'affiche dans la cellule...

peut etre que je m'y prend mal.. sans doute !

peux tu m'aider encore un peu !

merci
09/12/2009, 15h05
djoumusic

MERCATOG
je n'avais pas vu la page 2...
et ton code est merveilleux !!!!!!!!!!!
c'est exactement ça !!!!!

alors 2 choses...
est ce que l'on peut avoir des titres en premiere cellules... car lorsque l'on ecrit des intitulés... lors de la macro, ils s'effacent...

et comment analyser plusieurs cellules de A2 a A25 par exemple...

1000 merci !!

La différence entre une fonction (qui retourne une valeur) et une procédure
pour ne pas effacer ta première ligne

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
Option Explicit
 
Private Sub CommandButton1_Click()
Dim Rng As Range
Dim Tablo, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
Set Rng = Range("A2")
Contenu = Replace(Rng.Formula, "=", "")
 
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Contenu, "+")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
    Range("B2:D" & Cells(Rows.Count,2).End(xlUp).Row).ClearContents  'ICI MODIF
    For i = 0 To UBound(ArguFreq, 1)
        Range("B" & i + 2).Value = ArguFreq(i, 0)
        Range("C" & i + 2).Value = ArguFreq(i, 1)
        Range("D" & i + 2).Value = Range("B" & i + 2).Value * Range("C" & i + 2).Value
    Next i
    Range("D" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
End If
Set Rng = Nothing
End Sub

des titres

10/12/2009, 08h51
mercatog

Mais soyons sérieux et je me répète: arrête tes messages privés
le forum est fait pour l'entraide et non pour faire le travail à la place d'autrui
j'attendais des questions sur le code (non commenté exprès)
en retour, j'ai l'impression que tu te contente du résultat sans comprendre "qui fais quoi".
J'arrête ici pour le moment! tu as tous les ingrédients
à toi de comprendre pour pouvoir adapter
10/12/2009, 12h13
djoumusic
mercatog,
content de te lire, mais moins du contenu...
biensur un forum d'entraide, mais lorsque tu me pose une question ou la reponse est deja posé dans le post precedent, je passe en message privé biensur...

bien entendu que j'essai de comprendre les code et de les adapter a chaque fois... sinon, ca sert a rien..
mais je ne me concidere pas expert.. mais GROS DEBUTANT, avec l'envie de comprendre..
alors les formules, les termes, je ne les memorise pas forcement, mais dans la procedure du cheminement, de l'ecriture, je comprend par quelles etapes, le code nous fait passer.

je reviens a mon probleme,
chaque serveur, qui me rend des tickets resto a un ligne ( soit autant de ligne que de serveurs )
dans la colonne ticket resto ( dans ton code c'est la cellule A2 ) et chez moi, c'est de la cellule E5 à E35, j'ai en fin de journée quasiment 20 cellule ecrite,
ton code marche super sur 1 cellule A2
Code:

1 2 Set Rng = Range("A2") Contenu = Replace(Rng.Formula, "=", "")
j'ai essayer
Code:

1 2 Set Rng = Range("A2:A25") Contenu = Replace(Rng.Formula, "=", "")
Mais la ligne du dessous "bug"...

ma question c'est comment on ecrit que le contenu doit regarder toutes les cellules, avant d'afficher le resultat...

y a pas de quoi se contrarié ou se vexer...
10/12/2009, 12h43
mercatog
Bonjour,
on avance
je n'ai pas l'intention de vous intimider par mon précédent post
par ta demande initiale nous avions parlé d'une seule cellule (où la formule est écrite)
j'ai pris en exemple la cellule A2
le résultat est écrit sur plusieurs lignes à partir de B2 et la fréquence de chaque ticket est écrite à partir de la cellule C2

maintenant
tes données sont sur plusieurs cellules (de E5 à E35)

ma question
le résultat souhaité:
1. tu désire pour chaque cellule, tu as le dispaching des tickets avec leur fréquence
ou
2. le dispaching de tous les tickets contenus dans la plage E5:E35 et le résultat sera à partir de la cellule F5 (pour les tickets) et à partir de G5 (pour les fréquences)

pour le 1. on fera une boucle sur chaque ligne (du code précédent)
exemple:
Code:

1 2 3 4 5 Dim c as range Set Rng = Range("E5:E35") for each c in Rng ...'le même code next c
sauf que, nous devons connaitre où écrire le résultat de chaque cellule.

pour le 2, dans la cellule E36 (par exemple) on rassemble toutes les formules en une seule et on travail avec le code précédent.

PS: dans le code le tableau ArguFreq permet de récupérer chaque ticket avec sa fréquence. c'est l'essentiel

J'espère que ta réponse sera claire (si mes questions le sont)
Je suis aussi débutant et grâce à ce forum, j'ai appris les quelques notions!
Bon courage
10/12/2009, 14h52
djoumusic

Mercatog, merci

mon souhait est de rassembler le contenu de toute les cellules dans une seule, et de faire le dispatch de la cellule contenant TOUTs les contenus..

je ne sais pas rassembler le contenu de plusieurs cellules en 1 seule, et partant de cette façon, ton premier code est parfait..

j'ai tenter d'ecrire ça

Code:

Range("A10") = Range("A7").Formula + Range("A8").Formula

c'est presque ca, mais je recupere le signe egale de la 2eme cellule, du coup l'addition ne se fait pas...

j'essaie....

ta plage dans E5:Ex (x n'importe quel ligne>5)
ton résultat à partir de F5 (tickets) et G5 (fréquences)

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
Private Sub CommandButton1_Click()
Dim Rng As Range
Dim Tablo, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
Set Rng = Range("E5:E35")
For i = 5 To Cells(Rows.Count, 5).End(xlUp).Row
    Contenu = Contenu & "+" & Range("E" & i).Formula
Next i
Contenu = Replace(Mid(Contenu, 2), "=", "")
 
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Contenu, "+")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
    Range("F5:H" & Cells(Rows.Count, 8).End(xlUp).Row).ClearContents 'ICI MODIF
    For i = 0 To UBound(ArguFreq, 1)
        Range("F" & i + 5).Value = ArguFreq(i, 0)
        Range("G" & i + 5).Value = ArguFreq(i, 1)
        Range("H" & i + 5).Value = Range("F" & i + 5).Value * Range("G" & i + 5).Value
    Next i
    Range("H" & i + 5).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
End If
Set Rng = Nothing
End Sub

Edit: j'ai modifié cette ligne de code:

Code:

Range("F5:H" & Cells(Rows.Count, 8).End(xlUp).Row).ClearContents '8 à la place de 2

10/12/2009, 17h17
djoumusic

Mercatog, c'est exactement ça..

en faisant un copier-coller de ton code, pour le comprendre,
en G5 et H5, j'obtiens un resultat, que je n'arrive pas a interpreter... qu'est ce que c'est...?

si je veux delimiter la zone de regard des cellules, uniquement, de E5 à E35, comment on fait,
parce que actuellement, a E36,à E47 ca continue a compter...
je pense que c'esrt dans cette instruction

Code:

For i = 5 To Cells(Rows.Count, 5).End(xlUp).Row

on ecrit comme ça

Code:

For i = 5 To Cells(Rows.Count, 5).Cells(Rows.Count,35).Row

Code:

For i = 5 To 35

Code:

1
2
en faisant un copier-coller de ton code, pour le comprendre,
en G5 et H5, j'obtiens un resultat, que je n'arrive pas a interpreter... qu'est ce que c'est...?

si tu peux être explicite
ou joindre un fichier exemple

ci joint code légèrement modifié

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
Option Explicit
 
Private Sub CommandButton1_Click()
Dim Rng As Range
Dim Tablo, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
Set Rng = Range("E5:E35")
For i = 5 To 35
    If Range("E" & i).Formula <> "" Then Contenu = Contenu & "+" & Range("E" & i).Formula
Next i
Contenu = Replace(Mid(Contenu, 2), "=", "")
 
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Contenu, "+")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            If IsNumeric(Tablo(i)) Then TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
    Range("F5:H" & Cells(Rows.Count, 8).End(xlUp).Row).ClearContents 'ICI MODIF
    For i = 0 To UBound(ArguFreq, 1)
        Range("F" & i + 5).Value = ArguFreq(i, 0)
        Range("G" & i + 5).Value = ArguFreq(i, 1)
        Range("H" & i + 5).Value = Range("F" & i + 5).Value * Range("G" & i + 5).Value
    Next i
    Range("H" & i + 5).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
End If
Set Rng = Nothing
End Sub

Mercatog,
dans le code que tu me propose, les chiffres a virgules genre 6,2 ne passe pas

alors, j'ai repris ton premier code et ajouter le code pour delimiter la zone de cellules,..

ceci est un essai a adapter apres sur mes bonnes colonnes, mais en tout cas, ca marche !!

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
Sub CommandButton1_Click()
Dim Rng As Range
Dim Tablo, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
Set Rng = Range("A5:A35")
For i = 5 To 35
    If Range("A" & i).Formula <> "" Then Contenu = Contenu & "+" & Range("A" & i).Formula
Next i
 
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Contenu, "+")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
 
    For i = 0 To UBound(ArguFreq, 1)
        Range("B" & i + 2).Value = ArguFreq(i, 0)
        Range("C" & i + 2).Value = ArguFreq(i, 1)
        Range("D" & i + 2).Value = Range("B" & i + 2).Value * Range("C" & i + 2).Value
    Next i
    Range("D" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
 
    Range("C" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
End If
Set Rng = Nothing
End Sub

j'ai enlever la foncion d'effacer les colonnes, pour pouvoir garder mes titres dans mes cellule,
je rajouterai une macro pour effacer les colonnes a partir de la ligne 2, et pas toutes entiere ( pour garder mes titres )

connais tu un code autre que (colomns.clear) je crois que c'etait un truc du genre, pour effacer la colonne partir de la ligne 5 (ou peu importe le numero de ligne d'ailleurs, mais de pouvoir delimiter )

cdt

Ci joint code:

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
Option Explicit
Sub CommandButton1_Click()
Dim Tablo, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
For i = 5 To 35
    If Range("A" & i).Formula <> "" Then Contenu = Contenu & "+" & Range("A" & i).Formula
Next i
Contenu = Mid(Contenu, 3)
Contenu = Replace(Contenu, "=", "")         'à enlever si on est sur que le signe = ne sera jamais présent dans les formules
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Contenu, "+")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            If Tablo(i) <> "" Then TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
    Range("B2:D" & Range("D2").End(xlDown).Row).ClearContents
    For i = 0 To UBound(ArguFreq, 1)
        Range("B" & i + 2).Value = CDbl(ArguFreq(i, 0))
        Range("C" & i + 2).Value = ArguFreq(i, 1)
        Range("D" & i + 2).Value = Range("B" & i + 2).Value * Range("C" & i + 2).Value
    Next i
    Range("C" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
    Range("D" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
End If
End Sub

11/12/2009, 23h46
djoumusic

mercatog,

je vois le code pour effacer a partir de la 2 eme ligne..

sache que dans ton code, si dans la cellule j'ai +3,2+3,2
le resultat affiché est est 2 pour le nombre d'argument additioné mais pas 3,2, il n'y a rien dans la cellule prévu a cet effet,

par contre pour des nombre entier... +8+8+8
j'ai bien
3-------8-----24

cdt

tu as peut être conflit de séparateur décimal, essaie ceci

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
Sub CommandButton1_Click()
Dim Tablo, ArguFreq
Dim Contenu As String
Dim TempTab As Collection
Dim i As Byte, j As Byte
 
For i = 5 To 35
    If Range("A" & i).Formula <> "" Then Contenu = Contenu & "+" & Range("A" & i).Formula
Next i
Contenu = Mid(Contenu, 3)
Contenu = Replace(Contenu, ",", ".")
Contenu = Replace(Contenu, "=", "")         'à enlever si on est sur que le signe = ne sera jamais présent dans les formules
If Len(Trim(Contenu)) > 0 Then
    Tablo = Split(Contenu, "+")
    Set TempTab = New Collection
        On Error Resume Next
        For i = 0 To UBound(Tablo)
            If Tablo(i) <> "" Then TempTab.Add Tablo(i), Tablo(i)
        Next i
 
        ReDim ArguFreq(0 To TempTab.Count - 1, 0 To 1)
        For i = 1 To TempTab.Count
            ArguFreq(i - 1, 0) = TempTab.Item(i)
        Next i
 
        For i = 0 To TempTab.Count - 1
            For j = 0 To UBound(Tablo)
                If ArguFreq(i, 0) = Tablo(j) Then ArguFreq(i, 1) = ArguFreq(i, 1) + 1
            Next j
        Next i
    Set TempTab = Nothing
    Range("B2:D" & Range("D2").End(xlDown).Row).ClearContents
    For i = 0 To UBound(ArguFreq, 1)
        Range("B" & i + 2).Value = ArguFreq(i, 0)
        Range("C" & i + 2).Value = ArguFreq(i, 1)
        Range("D" & i + 2).Value = Range("B" & i + 2).Value * Range("C" & i + 2).Value
    Next i
    Range("C" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
    Range("D" & i + 2).FormulaR1C1 = "=sum(R[" & -i & "]C:R[-1]C)"
End If
End Sub