compter le nombre d'arguments

Version imprimable

Voir 40 message(s) de cette discussion en une page

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

Voir 40 message(s) de cette discussion en une page