Discussion :

[oscar.cesar]

bonjour
je suis toujours dans mon probleme de comptage de ligne .
je joins le fichier
le code complet est le suivant:

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
 
Sub test()
 
Dim nbl
 
 
Sheets("feuil1").Range("B6" & ":IV" & fligne + 6).ClearContents 'efface les ligne de B6 à BXXX
 
fligne = Sheets("feuil1").Range("B6").End(xlDown).Row + 1
nbl = Sheets("feuil1").Range("B6:b" & Sheets("feuil1").Range("B65536").End(xlUp).Row).Rows.Count
 
 
'test le nombre de ligne entre B6 et BXXX si celuici est inferieure à 2 alors arreter la procedure en cours et afficher attention nombre de ligne insuffisante, calcul impossible
If nbl < 2 Then
    MsgBox ("attention nombre de ligne insuffisante, calcul impossible")
    End
End If
 
 
valeurs = Sheets("liste").Range("G2:G11") 'valeurs des points attribuer à chaque position
 
 
Dim liste As Collection
Set liste = New Collection
For n = 6 To Range("B65536").End(xlUp).Row
 For m = 2 To Cells(n, 256).End(xlToLeft).Column
   On Error Resume Next
     liste.Add Cells(n, m), CStr(Cells(n, m))
   On Error GoTo 0
 Next m
Next n
ligne = Range("B65536").End(xlUp).Row + 3
Dim tablo()
ReDim tablo(liste.Count, 4)
For n = 1 To liste.Count
 tablo(n, 1) = liste(n)
Next n
For n = 6 To Range("B65536").End(xlUp).Row
 For m = 2 To Cells(n, 256).End(xlToLeft).Column
   For x = 1 To liste.Count
     If tablo(x, 1) = Cells(n, m) Then
       tablo(x, 2) = tablo(x, 2) + 1
       tablo(x, 3) = tablo(x, 3) & CStr(m - 1) & " "
       tablo(x, 4) = tablo(x, 4) + valeurs(m - 1, 1)
     End If
   Next x
 Next m
Next n
 
For n = 1 To liste.Count
 For m = n + 1 To liste.Count
   If tablo(n, 4) < tablo(m, 4) Then
     temp1 = tablo(n, 1)
     temp2 = tablo(n, 2)
     temp3 = tablo(n, 3)
     temp4 = tablo(n, 4)
     tablo(n, 2) = tablo(m, 2)
     tablo(n, 1) = tablo(m, 1)
     tablo(n, 3) = tablo(m, 3)
     tablo(n, 4) = tablo(m, 4)
     tablo(m, 2) = temp2
     tablo(m, 1) = temp1
     tablo(m, 3) = temp3
     tablo(m, 4) = temp4
   End If
 Next m
Next n
ligne = Range("B65536").End(xlUp).Row + 4
For n = 1 To liste.Count
 Cells(ligne, 1 + n) = tablo(n, 1)
 Cells(ligne + 1, 1 + n) = tablo(n, 2)
 Cells(ligne + 2, 1 + n) = tablo(n, 3)
 Cells(ligne + 3, 1 + n) = tablo(n, 4)
 
Next n
End Sub

le code sur le comptage est le suivant

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
 
............
sheets("feuil1").Range("B6" & ":IV" & fligne + 6).ClearContents 'efface les ligne de B6 à BXXX
 
fligne = Sheets("feuil1").Range("B6").End(xlDown).Row + 1
nbl = Sheets("feuil1").Range("B6:b" & Sheets("feuil1").Range("B65536").End(xlUp).Row).Rows.Count
 
 
'test le nombre de ligne entre B6 et BXXX si celuici est inferieure à 2 alors arreter la procedure en cours et afficher attention nombre de ligne insuffisante, calcul impossible
If nbl < 2 Then
    MsgBox ("attention nombre de ligne insuffisante, calcul impossible")
    End
End If
 
...............

la, je coince car quand le nb de ligne est egale à 1 alors le test est bon dans son resultat mais si le nb de ligne est egale = 0 alors le test ne se realise pas ?




merci

[Jean-Philippe André]

bonjour,
tu te compliques la tache à mon avis.
Ceci devrait être suffisant :

Code :

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

nbl = Sheets("feuil1").Range("B65536").End(xlUp).Row - 6

[oscar.cesar]

bonjour
juste une modif

Code :

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

1
2
 
nbl = Sheets("feuil1").Range("B65536").End(xlUp).Row - 5

c'est vrai , cela est plus simple.


merci