Discussion :

[Sebphyto]

Bonjour à tous,

Désolé de revenir si tard sur ce sujet, mais j'étais pris sur un autre.....

Petit rappel :

- J'ai toujours ce problème de textbox "synthèse" mal renseignés, du 1er au dernier textbox, cela doit se ranger du nombre de fois que le numéro est présent dans les cases "chevaux favoris" à "entraineurs favoris", sans qu'il ne compte les textbox vide.

- De là, le résultat doit-être consigné dans la feuille "Bdd", mais pour cela je devrais m'en sortir!!!!

Merci pour votre aide

Seb
Pièce jointe 174807

[Sebphyto]

Je bloque encore une fois
Dans la procédure ci-dessous, j'ai un tableau (voir image plus haut post#16), qui me permet de trier et compter le nombre de fois qu'un numéro est présent, puis le classe par le nombre de fois que le numéro est présent (ordre du + grand au +petit), puis me retranscris le résultat dans des textbox (de 31 à 40)

Hors dans ce tableau il peut y avoir des "Zéro", qui sont également comptabilisé.....Mais je ne le souhaite pas, il faut que les "zéros" soit exclu...

Voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub LancerAna_Click()
'Lance l'analyse, le comptage du nb de x que les numéro sont présent
Dim TabBase
TabBase = Range(Cells(1, 1), Cells(3, 10))
 
Dim TabRes() As Variant
ReDim TabRes(1 To UBound(TabBase, 1) * UBound(TabBase, 2), 1 To 5)
 
cpt = 1
For I = 1 To UBound(TabBase, 1)
    For j = 1 To UBound(TabBase, 2)
        'Debug.Print TabBase(I, j)
        TabRes(cpt, 1) = TabBase(I, j)
        'Debug.Print TabRes(cpt, 1)
        cpt = cpt + 1
    Next j
Next I
 
' repére le doublon !
For I = 1 To UBound(TabRes, 1)
    For j = I + 1 To UBound(TabRes, 1)
        If TabRes(I, 1) = TabRes(j, 1) Then
            TabRes(j, 2) = "Doublon"
        End If
    Next j
Next I
 
' Compteur du nombre de fois qu'il y a le numéro !
For I = 1 To UBound(TabRes, 1)
    For j = 1 To UBound(TabRes, 1)
        If TabRes(I, 1) = TabRes(j, 1) Then
            TabRes(I, 3) = TabRes(I, 3) + 1
            TabRes(I, 4) = TabRes(I, 3) & TabRes(I, 1)
            TabRes(I, 5) = TabRes(I, 1)
            'TabRes(i, 5) = "Il y a " & TabRes(i, 3) & " fois le NB : " & TabRes(i, 1) & " x dans le Tableau"
        End If
    Next j
Next I
 
'Cells(13, 6).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
 
' tri
Call Tri(TabRes(), 4, LBound(TabRes, 1), UBound(TabRes, 1))
 
'Cells(13, 6).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
 
cpt = Empty
Dim TabAff() As Variant
' Compte le NB ligne sans doublon !
For I = 1 To UBound(TabRes, 1)
    If TabRes(I, 2) <> "Doublon" Then
        cpt = cpt + 1
    End If
Next I
ReDim TabAff(1 To cpt, 1 To 1)
 
cpt = 1
For I = 1 To UBound(TabRes, 1)
    If TabRes(I, 2) <> "Doublon" Then
        TabAff(cpt, 1) = TabRes(I, 5)
        cpt = cpt + 1
    End If
Next I
 
Cells(7, 2).Resize(UBound(TabAff, 1), UBound(TabAff, 2)) = TabAff
 
'y = 33
y = Range("B" & Rows.Count).End(xlUp).Row
For x = 31 To 40 'texbox de 31 à 40
  With Sheets("Analyses")
   If .Range("B" & y).Value >= 1 Then
      Me.Controls("TextBox" & x) = .Range("B" & y).Value
     y = y - 1 'en remontant
      'y = y + 1 'en descandant à partir de 33
    End If
  End With
Next x
'prévoir à consigner les num dans base de donnée "feuille BDD"
 
End Sub
 
Sub Tri(TabRes(), ColTri, gauc, droi) ' Quick sort
  ref = TabRes((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While TabRes(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < TabRes(d, ColTri): d = d - 1: Loop
    If g <= d Then
       For k = LBound(TabRes, 2) To UBound(TabRes, 2)
         temp = TabRes(g, k): TabRes(g, k) = TabRes(d, k): TabRes(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri(TabRes, ColTri, g, droi)
  If gauc < d Then Call Tri(TabRes, ColTri, gauc, d)
 
End Sub

A+

[Invité]

bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Type Nb
    Nbr As Long
    Nb As Long
End Type
Sub test1()
Dim T(100) As Nb, t2 As Nb
Dim TabBase As Range
Set TabBase = Range(Cells(1, 1), Cells(3, 10))
 
'On compte les occurence
For I = 1 To TabBase.Count
    T(Val(TabBase(I).Value)).Nbr = Val(TabBase(I).Value)
    T(Val(TabBase(I).Value)).Nb = T(Val(TabBase(I).Value)).Nb + 1
Next
'on trie le tableau
For I = 1 To UBound(T)
    If T(I).Nb > T(I - 1).Nb Then
        t2 = T(I)
        T(I) = T(I - 1)
        T(I - 1) = t2
        I = I - 2
        If I < 0 Then I = 0
    End If
Next
txb = 1
'on affiche les le valeurs.
For I = 1 To UBound(T)
    If T(I).Nbr > 0 Then Me.controles("Texbox" & txb) = T(I).Nbr: txb = txb + 1
Next
End Sub