Discussion :

[pascal4782]

Bonjour à tous,

J'essaye de remplacer les lignes de code marquées de 'X, Y et Z par une variable compteur sans succès (ligne de code 27 à 32).
En effet:
- en X je compte a posteriori le nombre de données > 40 dans la colonne HP
- en Y je compte a posteriori le nombre de données <20 dans la colonne HP
- en Z je compte a posteriori par une formule (strFormuleB) le nombre de données de la colonne HP>40 et HO>8
Alors qu'il suffirait de compter au fur et a mesure et d'inscrire le résultat final plutôt que de balancer des formules

Cordialement

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
Sub Element()
 
 Dim I As Double, J As Double, A As Double, m As Double, n As Double
 Dim h As Long, k As Long
 Dim strFormuleA As String, strFormuleB As String
 
Application.Calculation = xlCalculationManual
 
For h = -9 To -2 'For h = -9 To -2
k = h + 9
 
    strFormuleA = "=IF(AND(ISEVEN(RC[-12]),ISEVEN(RC[" & h & "])),RC[-14],"""")"
    Range("HL2:HL70001").FormulaR1C1 = strFormuleA
 
    Range("HN2:HP1010").ClearContents
    m = 1
    n = 70
    For A = 0 To 999
        I = (70 * A) + m
        J = (70 * A) + n
        Range("HN1").Value = "=COUNTIF(R[" & I & "]C[-2]:R[" & J & "]C[-2],0)"
        Range("HO1").Value = "=COUNTIF(R[" & I & "]C[-3]:R[" & J & "]C[-3],1)"
        Range("HP1").Value = "=100*RC[-1]/(RC[-1]+RC[-2])"
        Range("HN2:HP2").Offset(A, 0).Value = Range("HN1:HP1").Value
    Next
 
    Range("HR1").Value = "=COUNTIF(R[1]C[-2]:R[1001]C[-2],"">=40"")" '''''''''X
    Range("HS1").Value = "=COUNTIF(R[1]C[-3]:R[1000]C[-3],""<=20"")" '''''''''Y
 
    strFormuleB = "=IF(AND(RC[-1]>40,RC[-2]>8),1,"""")" '''''''''''Z
    Range("HQ2:HQ1002").FormulaR1C1 = strFormuleB
    Range("HT1").Value = "=SUM(R[1]C[-3]:R[1001]C[-3])"
 
    Range("Hu1:Hw1").Offset(0, k * 3).Value = Range("HR1:HT1").Value
Next
    Range("HU70000").End(xlUp)(2).Resize(1, 24).Value = Range("HU1:IR1").Value
    Range("HU1:IR1").ClearContents
   Application.Calculation = xlCalculationAutomatic
 
End Sub

[pascal4782]

Re,

L'inspiration est venue en consultant le tuto de Silkyroad sur les variables
Je joins le programme modifié, mais je suis preneur de toutes idées qui amélioreraient le code. Il y a de grandes chances qu'il recèle des maladresses.

Cordialement

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
Sub Element()
 
 Dim I As Double, J As Double, A As Double, m As Double, n As Double
 Dim h As Long, k As Long
 Dim Var1 As Long, Var2 As Long, Var3 As Long
 Dim strFormuleA As String
 
Application.Calculation = xlCalculationManual
 
For h = -9 To -2
k = h + 9
 
    strFormuleA = "=IF(AND(ISEVEN(RC[-12]),ISEVEN(RC[" & h & "])),RC[-14],"""")"
    Range("HL2:HL70001").FormulaR1C1 = strFormuleA
 
    Range("HN2:HP1010").ClearContents
    m = 1
    n = 70
    Var1 = 0
    Var2 = 0
    Var3 = 0
    For A = 0 To 999
        I = (70 * A) + m
        J = (70 * A) + n
        Range("HN1").Value = "=COUNTIF(R[" & I & "]C[-2]:R[" & J & "]C[-2],0)"
        Range("HO1").Value = "=COUNTIF(R[" & I & "]C[-3]:R[" & J & "]C[-3],1)"
        Range("HP1").Value = "=100*RC[-1]/(RC[-1]+RC[-2])"
 
        If Range("HP1") >= 40 Then Var1 = Var1 + 1
        If Range("HP1") <= 20 Then Var2 = Var2 + 1
        If (Range("HP1") > 40 And Range("HO1") > 8) Then Var3 = Var3 + 1
 
        Range("HN2:HP2").Offset(A, 0).Value = Range("HN1:HP1").Value
    Next
 
    Range("HR1").Value = Var1
    Range("HS1").Value = Var2
    Range("HT1").Value = Var3
    'Range("HR1").Value = "=COUNTIF(R[1]C[-2]:R[1001]C[-2],"">=40"")" '''''''''X
    'Range("HS1").Value = "=COUNTIF(R[1]C[-3]:R[1000]C[-3],""<=20"")" '''''''''Y
 
    'strFormuleB = "=IF(AND(RC[-1]>40,RC[-2]>8),1,"""")" '''''''''''Z
    'Range("HQ2:HQ1002").FormulaR1C1 = strFormuleB
    'Range("HT1").Value = "=SUM(R[1]C[-3]:R[1001]C[-3])"
 
    Range("Hu1:Hw1").Offset(0, k * 3).Value = Range("HR1:HT1").Value
Next
    Range("HU70000").End(xlUp)(2).Resize(1, 24).Value = Range("HU1:IR1").Value
    Range("HU1:IR1").ClearContents
   Application.Calculation = xlCalculationAutomatic
 
End Sub