1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. Visual Basic 6

Synthèse de 3 séries

Signaler
Messages postés
4
Date d'inscription
mercredi 16 février 2011
Statut
Membre
Dernière intervention
22 février 2011
 -
Messages postés
75
Date d'inscription
mercredi 17 août 2011
Statut
Membre
Dernière intervention
27 septembre 2011
 -
Bonjour,

J'ai une nouvelle demande, en espèrant que celle-ci soit faisable. Je vous prie de trouver ci-joint un petit fichier simple en exemple. J'ai rentré 3 séries de lignes, et le but est que la dernière fasse la synthèse des 3 en mettant dans la première case le chiffre qui revient le plus souvent en premier, puis en second, etc...

Fichier série

Merci à vous pour votre aide.
Amicalement
Afficher la suite

1 réponse

Réponse 1 / 1
Messages postés
75
Date d'inscription
mercredi 17 août 2011
Statut
Membre
Dernière intervention
27 septembre 2011
 2
Bonjour,

Ci-dessous le code qui est en relation avec votre fichier Excel (Version 2007).

Le code VBA ci-dessous est du code VBA pour Excel 2003.

Principe :
- Récupération des nombres de la feuille 1
- Cumul des valeurs dans un tableau
- Tri
- Alimentation de la dernière ligne (Entre les parenthèses nombre de fois que le numéro est dans les séries).

Didier


Public Sub Regroupement()


'On recupére les données dans un tableau
'

'Première série
'4 9 15 1 6 12 8 3

'Deuxième série
'1 3 9 8 4 17 15 14

'Troisième série
'2 9 6 8 12 15 7 1

Dim Wtableau(23) As Integer, K25 As Integer
Dim I As Integer, j As Integer

Dim Wtableau_bis(23) As Integer
Dim Wtableau_ter(23) As Integer

rwindex = 3
colindex = 2
K25 = 0

For I = 1 To 3

For j = 1 To 8
Wtableau(K25) = Application.Worksheets("Feuil1").Cells(rwindex, colindex).Value
colindex = colindex + 1
K25 = K25 + 1
Next j

rwindex = rwindex + 3
colindex = 2

Next I

'

For I = 0 To 23

Wtableau_bis(Wtableau(I)) = Wtableau_bis(Wtableau(I)) + 1

Next I

'
For I = 0 To 23

Wtableau_ter(I) = I

Next I

'
Dim Wzap As String, Zwap1 As String



'
'Tri
'
Do
K25 = 0

For I = 0 To UBound(Wtableau_bis) - 1
If Wtableau_bis(I) < Wtableau_bis(I + 1) Then
Zwap = Wtableau_bis(I)
Zwap1 = Wtableau_ter(I)

Wtableau_bis(I) = Wtableau_bis(I + 1)
Wtableau_ter(I) = Wtableau_ter(I + 1)

Wtableau_bis(I + 1) = Zwap
Wtableau_ter(I + 1) = Zwap1

K25 = 1
End If
Next I
Loop While K25 = 1

'
'Enregistrement dans la feuille
'

rwindex = 14
colindex = 2

'
'

For I = 0 To 23

If Wtableau_bis(I) <> 0 Then
Application.Worksheets("Feuil1").Cells(rwindex, colindex).Value = Wtableau_ter(I) & "(" & Wtableau_bis(I) & ")"
End If

colindex = colindex + 1

Next I


MsgBox " Ok .. "

End Sub
Répondre Posez votre question