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 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
|
Private Sub CommandButton1_Click()
Dim kk As Integer 'index tableaufiltreprochainXXXX
Dim liste As New Collection
Dim i As Long, DerniereLigne As Integer
Dim k As Integer, colonne As Integer
Dim nbinf As Integer, nbsup As Integer, nbegal As Integer
Dim resultat() As Integer
Dim typedepari As Integer
Dim a
Dim b As Single
Dim c As Single
Dim d As Single
Dim aa As Integer ' valeur somme
Dim tablfiltreprochainsup() As Integer 'tableau dont la prochaine valeur sera sup
Dim tablfiltreprochaininf() As Integer 'tableau dont la prochaine valeur sera infdi
'initialization des divers variables
Erase tablfiltreprochainsup 'initialise les tableau si ils sont declares en dimension statique
Erase tablfiltreprochaininf
Erase tableau1
typedepari = 0
colonne = 0
aa = 0
a = 0
b = 0
c = 0
d = 0
kk = 0
k = 0
UserForm4.TextBox1.Value = ""
UserForm4.TextBox3.Value = ""
UserForm4.TextBox4.Value = ""
nbegal = 0
nbinf = 0
nbsup = 0
CheckBox1.Value = True
If OptionButton1.Value = True And CheckBox1.Value = True Then typedepari = 5
'ici on rajoute d'autre optionbutton
Worksheets("stat").Select ' selectionne la feuille stat
Select Case typedepari
Case 5 'somme à 5
DerniereLigne = Range("j65536").End(xlUp).Row
colonne = 10
infofiltre = "Somme pour le quinte"
Case 4 'somme à 4
DerniereLigne = Range("k65536").End(xlUp).Row
colonne = 11
infofiltre = "Somme pour le quarte"
Case 3 'somme 4
DerniereLigne = Range("l65536").End(xlUp).Row
colonne = 12
infofiltre = "Somme pour le tierce"
'ici on rajoute d'autre choix
End Select
On Error Resume Next
For i = 2 To DerniereLigne
liste.Add Cells(i, colonne), CStr(Cells(i, colonne))
Next i
On Error GoTo 0
ReDim resultat(1 To 4, 1 To liste.Count)
For k = 1 To liste.Count
'redimensionnement des tableau
'ReDim tablfiltreprochaininf(k)
'ReDim tablfiltreprochainsup(k)
nbegal = 0
nbinf = 0
nbsup = 0
For i = 2 To DerniereLigne - 1
If Cells(i, colonne) = liste.Item(k) Then
If Cells(i, colonne) > Cells(i + 1, colonne) Then nbinf = nbinf + 1
If Cells(i, colonne) = Cells(i + 1, colonne) Then nbegal = nbegal + 1
If Cells(i, colonne) < Cells(i + 1, colonne) Then nbsup = nbsup + 1
End If
Next i
resultat(1, k) = liste.Item(k) 'a la valeur somme
resultat(2, k) = nbinf 'b
resultat(3, k) = nbegal 'c
resultat(4, k) = nbsup 'd
'redimensionne les tableaux à revoir pour ne prendre que les dimensions pour inf et sup
Next k
UserForm4.TextBox1.Value = ""
UserForm4.TextBox1.Value = infofiltre & vbCrLf 'affiche l'info sur quel filtre a été realise la stat
'affichage dans le textbox
For k = 1 To liste.Count
aa = resultat(1, k) ' la somme concernee
a = resultat(1, k) & "a été trouve " & (resultat(2, k) + resultat(3, k) + resultat(4, k)) 'la valeur somme
b = (FormatNumber((resultat(2, k) * 100) / (resultat(2, k) + resultat(3, k) + resultat(4, k)), 0)) 'inf
c = (FormatNumber((resultat(3, k) * 100) / (resultat(2, k) + resultat(3, k) + resultat(4, k)), 0)) '=
d = (FormatNumber((resultat(4, k) * 100) / (resultat(2, k) + resultat(3, k) + resultat(4, k)), 0)) 'sup
'test que le textbox2 du % est bien rempli et s> à 0
If UserForm4.TextBox2.Value > 0 Then
If b > UserForm4.TextBox2.Value Then 'inf
UserForm4.TextBox1.Value = UserForm4.TextBox1.Value & "la valeur somme " & a & " fois : " & " " & b & " % des valeurs qui suivent seront < " & vbCrLf
UserForm4.TextBox4.Value = UserForm4.TextBox4.Value & aa & " " & vbCrLf 'affichag des somme retenues
'remplir le tablfiltresup
ReDim Preserve tablfiltreprochaininf(kk)
tablfiltreprochaininf(kk) = aa
'tableau1(kk) = aa
kk = kk + 1
End If
'If c > UserForm4.TextBox2.Value Then
'UserForm4.TextBox1.Value = UserForm4.TextBox1.Value & c & " % des valeurs qui suivent seront = "
'End
If d > UserForm4.TextBox2.Value Then 'sup
UserForm4.TextBox1.Value = UserForm4.TextBox1.Value & "la valeur somme " & a & " fois : " & d & " % des valeurs qui suivent seront > " & vbCrLf
UserForm4.TextBox3.Value = UserForm4.TextBox3.Value & aa & " " & vbCrLf 'affichag des somme retenues
'UserForm4.TextBox3.Value = UserForm4.TextBox3.Value & aa & " " & vbCrLf 'affichag des somme retenues
'remplir le tablfiltresup
ReDim Preserve tablfiltreprochainsup(kk)
tablfiltreprochainsup(kk) = aa
kk = kk + 1
End If
'UserForm4.TextBox1.Value = UserForm4.TextBox1.Value & vbCrLf ' saut le ligne dans le usf4.txt1
On Error Resume Next 'permet d'arreter le programme apres la premiere erreur située lors que l'indice i arrive à la derniere ligne de colonne
Else
If UserForm4.TextBox2.Value = 0 Or UserForm4.TextBox2.Value = "" Then 'borne du % souhaite =0 alors on affiche tout
UserForm4.TextBox1.Value = UserForm4.TextBox1.Value & "Il y a eu pour la valeur somme " & a & "fois : " & " " & b & "% des valeurs qui suivent seront < " & c & " " & "% des valeurs qui suivent seront = " & d & "% valeur qui suivent seront > " & vbCrLf
On Error Resume Next 'permet d'arreter le programme apres la premiere erreur située lors que l'indice i arrive à la derniere ligne de colonne
End If
End If
Next k
'affichage du contenu du tableau tablfiltresup passer en tableau dynamique redim à finier
For ii = LBound(tablfiltreprochainsup) To LBound(tablfiltreprochainsup) + kk - 1
'pour verifier que la tableaufiltreprochainXXXX est bien rempli
MsgBox (" affichage des somme au prochain tirg seront sup pour la valeur somme =" & tablfiltreprochainsup(ii))
Next ii
For ii = LBound(tablfiltreprochaininf) To LBound(tablfiltreprochaininf) + kk - 1
'pour verifier que la tableaufiltreprochainXXXX est bien rempli
MsgBox ("affichage des sommes au prochain tir sqeront inf pour la valeur somme " & tablfiltreprochaininf(ii))
Next ii
End Sub |
Partager