classer des series de nombres par synthese

Version imprimable

16/11/2007, 14h06
oscar.cesar

classer des series de nombres par synthese

bonjour à tous
je prefere ouvrir un nouveau post sur le sujet des groupements de serie de numeros en tenant compte des observations dans les derniers post.
Dans une feuille excel, j'ai des series de nombres.
a) une serie par ligne en sachant que le nombre de serie est variable et donc le nombre de ligne (le nombre de serie pouvant etre de 1 à 50 max)
b) une serie est composée de nombres. la quantite de nombre composant une serie est variable et peut varier entre chaque serie.(le nombre par serie pouvant etre de 1 à 20 maxi et longueur entre series peut etre differente).

ex: serie1 est composée 5-9-11
serie2 est composee de 15-8-9-6-3-7
etc.......
serie10 est 9-15-20-8-7

L'objectif est de regrouper ou de faire une synthese de serie (en VBA):

synthese simple:
serie1+serie2+...serie10 = 5-9-11-15-8-6-3-7-20

synthese par frequence , c'est à dire!:
le chiffe 5 est present 1 fois dans les series
le chiffre 9 est present 3 fois dans le seires
le chiffre 15 est present 2 fois dans les series
lz chiffre 8 est present 2 fosi dans les series
le chiffre 7 est present 2 fois dans les series
les autres chiffres etant presents 1 fois dans les series.
on classe les chiffres en fonction des frequences d'apparitions par ordre decroissant dans les serie on obtient alors
la synthese par frequence 9-15-8-7-5-11-6-3-7-20

Bonsoir à tous

Voici une macro en fonction de ce que j'ai compris

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
Public nb(100) As Integer
Sub compte()
    Dim i As Long, j As Long
    For i = 1 To Range("A65535").End(xlUp).Row
        For j = 1 To Range("IV" & i).End(xlToLeft).Column
            nb(Cells(i, j)) = nb(Cells(i, j)) + 1
        Next j
    Next i
    Dim drapeau As Boolean
    While max() > 0
        j = max()
        For i = 1 To 100
            If j = nb(i) Then
                Range("I10") = Range("I10") & i & " - "
                nb(i) = 0
                Exit For
            End If
        Next i
    Wend
End Sub
 
Function max() As Integer
    Dim i As Integer, v As Integer
    v = 0
    For i = 1 To 100
        If nb(i) > v Then v = nb(i)
    Next i
    max = v
End Function

Bon, j'ai pondu quelque chose.
La méthode consiste
1 - à créer un tableau1 de deux séries (prises sur deux lignes successives)
2 - à parcourir ce tableau afin de vérifier l'existence de la donnée dans un tableau2 à deux dimensions (une pour la valeur dans la série, une comme compteur)
3 - La donnée n'existe pas, on l'ajoute au second tableau et on incrémente le compteur
4 - La donnée existe, on incrémente seulement le compteur correspondant.
Le tableau1 parcouru,
5 - on l'efface et
6 - on passe aux deux lignes suivantes de la feuille de calculs
1 - création du tableau1
2 - parcours des deux tableaux
3 - etc.

Le résultat des séries est placé dans les 2 lignes qui suivent la première ligne vide de la plage de données.

Il te restera à trier le tableau mais là, SilkyRoad donne la méthode dans la FAQ ou dans un tutoriel et ça te laisse 58 heures jusqu'à lundi 8h pour le trouver :mouarf:
Bon week-end ;)

Edit

A plus de HIC ! J'ai trouvé les deux erreurs qui plombaient mon code.
Le code corrigé :

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
Option Explicit
 
Sub test()
Dim Recap(), Tablo(), DerniereLigne As Long, DerniereColonne As Integer
Dim NoCol As Integer, NoLigne As Long, NoC As Integer, n As Long
Dim Existe As Boolean, k As Integer, l As Integer, i As Integer, j As Integer
NoCol = 2 '1ère colonne de la série 'ne change pas, peut être une constante
NoLigne = 6 '1ère ligne de la série
    DerniereLigne = Cells(Columns(NoCol).Cells.Count, NoCol).End(xlUp).Row
    'Remplissage du tablo avec les deux lignes suivantes
    ReDim Tablo(0)
    ReDim Preserve Recap(0 To 1, 0)
    Do While NoLigne <= DerniereLigne
        DerniereColonne = Cells(NoLigne, Rows(NoLigne).Cells.Count).End(xlToLeft).Column
        For NoC = NoCol To DerniereColonne
            n = n + 1
            ReDim Preserve Tablo(n)
            Tablo(n) = Cells(NoLigne, NoC)
        Next
        NoLigne = NoLigne + 1
        DerniereColonne = Cells(NoLigne, Rows(NoLigne).Cells.Count).End(xlToLeft).Column
        For NoC = NoCol To DerniereColonne
            n = n + 1
            ReDim Preserve Tablo(n)
            Tablo(n) = Cells(NoLigne, NoC)
        Next
        NoLigne = NoLigne + 1
        'Création de la série
        For i = 1 To UBound(Tablo)
            For j = 1 To k
                Existe = Recap(0, j) = Tablo(i)
                l = j
                If Existe Then Exit For
            Next
            If Not Existe Then
                    k = k + 1
                    ReDim Preserve Recap(0 To 1, k)
                    Recap(0, k) = Tablo(i)
                    Recap(1, k) = Recap(1, k) + 1
                ElseIf Existe Then
                    Recap(1, l) = Recap(1, l) + 1
            End If
        Next
        ReDim Tablo(0)
        n = 0
    Loop
    For i = 1 To k
        Cells(DerniereLigne + 2, i + 1) = Recap(0, i)
        Cells(DerniereLigne + 3, i + 1) = Recap(1, i)
    Next
End Sub

Regarder la TV en cherchant un bug, dur dur !
Il reste le tri, si je retrouve l'URL, je te mets ça.
A+

Edit(re)
XIV-D. Trier les données d'un tableau
Une idée de ce que cela donne
Pièce jointe 21785

17/11/2007, 18h10
oscar.cesar

bonsoir à tous
merci a vous deux
je regarde cela.
j'au d'autre piste , je prendrais ce qui me semblera, apres essais etre le plus performant.

bon week au forum:yaisse2: