Si la somme des valeurs de l'individus est différent de 100, imputer la différence pour obtenir 100.

**Snemy** · 21/05/2014, 14h23

Bonjour à tous,

J'en appel à vos compétences face à cette difficulté que je n'arrive pas à résoudre... Ma Macro est extrêmement lente, pour 2300 lignes cela me prend 15 bonnes minutes...

J'explique ce que je souhaite faire:
Au préalable j'ai:
Colonne_A Colonne_B Colonne_H
XXX1 35.01 104.28
XXX1 34.15 104.28
XXX2 51.10 99.40
XXX2 48.30 99.40
XXX1 35.12 104.28

Ma colonne_h étant un simple Somme.si(A:B;A;A:B;B).

J'aimerais que ma macro, ajoute la différence entre (104.28-100= 4.28) à ma colonne_B afin que ma colonne_H passe à 100.

Pour cela, voici mon code:

Code :

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

1
2
3
4
5
6
7
Sub Cent_pour_cent()
    For i = 2 To Range("A3000").End(xlUp).Row Step 1
        'If Cells(i, 2) <> 100 Then (idée de départ mais extrêmement long).
        Cells(i, 2) = Cells(i, 2) + (100 - Cells(i, 8))
        'End If (idée de départ mais extrêmement long).
    Next i
End Sub

Avez-vous une idée d'où peux venir mon ralentissement ?

Merci à vous par avance.

**Kimy_Ire** · 21/05/2014, 14h58

Salut Snemy,

Calculs automatiques au sein de la feuille =

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub ma_sub()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
'ton code
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

Dis moi si ça marche mieux.

(C'est la troisième fois que je propose ça depuis le début de la semaine :

)

Cordialement,
Kimy

**Snemy** · 21/05/2014, 15h06

Hello Kimy,

Donc oui en calcul manuel cela marche mieux environs 3 secondes.
Mais le soucis c'est que:
Colonne_A Colonne_B Colonne_H
XXX1 35.01 104.28 Correction en manuel à 100
XXX1 34.15 104.28 Correction en manuel à 100

Les deux corrections vont faire que quand je repasse en calculer, je ne serais pas à 100 pour ma référence XXX1. :/

J'ai réfléchis deux minutes à faire un code qui fait la même chose sans calcul mais c'est impossible.
Ou alors inseré un SUMIF mais dans ce cas là le problème est le même il faut que excel calcul..

Merci à toi de m'apporter ton aide Kimy

PS: En calcul automatique, en effet les 4 coeurs de mon pc sont à 100%... il s'agit d'un "Inel(R) Core(TM) i5 CPU 2.40GHz"

**Kimy_Ire** · 21/05/2014, 15h13

Je n'ai pas compris ce que tu veux pour le coup.

Peux tu me définir précisément ce que tu veux dans la colonne et pourquoi ta formule ne fonctionne pas ?

Un petit fichier exemple également ?

**Snemy** · 21/05/2014, 15h21

Internet refuse que j'envois ce fichier, du coup en voici des screenshots.
Nom : Macro1.JPG
Affichages : 234
Taille : 22,8 Ko

Ma macro

Nom : Macro2.JPG
Affichages : 240
Taille : 28,7 Ko

Le fichier excel.

Ce que je veux c'est que la différence pour arrivé à 100 dans la colonne h soit imputé dans la colonne B, pour chaque matricule, afin qu'ils soient tous à 100.

En faite ma formule fonctionne, mais 200 ligne en 1mn à savoir que j'en ai 2600... Cela est extrêmement long.. c'est sa rapidité d'execution que j'aimerais augmenter.

J'espère avoir été clair.. :s

**Kimy_Ire** · 21/05/2014, 15h34

Donc dans ton exemple tu veux ajouter 0.03 sur les lignes 5, 6, 7, 10 et 11 c'est ça ?

Comment est calculé automatiquement ta cellule H ?

De plus => ton "If" n'est pas sur la colonne H... donc passe sur toutes les lignes...

Code :

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

1
2
3
If Cells(i, 8) <> 100 Then '(idée de départ mais extrêmement long).
    Cells(i, 2) = Cells(i, 2) + (100 - Cells(i, 8))
End If '(idée de départ mais extrêmement long).

**letudiant68** · 21/05/2014, 15h35

Bonjour, je vous propose une solution alternative (à mettre dans le code de la feuille) :

Code :

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

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Column = 2 Then Target = Target + (100 - Cells(Target.Row, 8))
    Application.EnableEvents = True
End Sub

L'évènement se déclenche dès que la valeur d'une cellule de la colonne B change (le EnableEvents = False empêche que l'évènement s'enclenche en boucle).

**Snemy** · 21/05/2014, 15h49

Oui Kimy je m'en suis aperçu à l'instant, je l'ai changé et cela me ramène à 1mn50 pour mes 1200 ligne <> de la colonne H.

Oui je veux que le total d'un matricule soit égale à 100 au final.

Letudiant68, merci pour votre réponse, mais je ne vois pas comment utiliser votre code VBA.. mes excuses..

**Kimy_Ire** · 21/05/2014, 16h08

Tu n'as pas répondu à ma question : Comment est calculé automatiquement ta cellule H ?

**Snemy** · 21/05/2014, 16h17

Il s'agit d'un =somme.si(A:B;A:A;B:B) donc du coup dès que je modifie une donnée de la colonne_B excel recalcule automatiquement le colonne_H.

**Kimy_Ire** · 21/05/2014, 16h28

Et ça ne serait pas plus pratique d'avoir une macro qui récapitule pour chaque ID le % et qui affecte la différence à la première occurrence trouvé la différence en B ? (Dans un nouvel onglet ou sur les colonnes H/I)

**Snemy** · 21/05/2014, 16h43

C'est à dire Kimy ? Pour moi ce que tu dis là c'est ce que fait la macro.. :/ il impute la différence dans la première occurence trouvé pour un matricule ce qui met colonne_H à 100 et du coup il ne s'occupe pas des autres lignes de ce matricule car elles sont à 100 via le recalcul qu'effectue excel.

**Marc-L** · 21/05/2014, 17h05

Bonjour, bonjour,

enregistrer un classeur au format .xls ou .xlsx n'est pas bien compliqué afin de le mettre en pièce jointe !
Évidemment doté d'une feuille source & d'une feuille résultat désiré et accompagné dans le message
d'une présentation claire et exhaustive ne laissant place à aucune ambiguïté …

__________________________________________________________________________________________
If you can’t explain it simply, you don’t understand it well enough … (Albert Einstein)

**Kimy_Ire** · 21/05/2014, 17h17

Je me suis amusé :

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
'Déclaration de ton tableau en public
Public table() As String
 
Sub recap()
'Déclaration de tes variables
Dim Rng As Range
Dim recal As Range
Dim col As Integer
 
'Redimensionnement de ton tableau (nécessaire pour pouvoir le redimentionner dynamiquement après)
ReDim table(1 To 2, 1 To 1)
'La colonne de ta première entrée (8 = H)
col = 8
 
'Avec la feuille "Feuil1"
With Worksheets("Feuil1")
    'On passe dans la fonction calcul_col sur H
    calcul_col (col)
 
    'On se place sur (ici) H1
    Set Rng = .Cells(1, col)
 
    'Et on fait en sorte qu'on est les valeurs correspondantes pour avoir une somme à 100
    For i = 1 To .Columns(col + 1).Find("*", , , , , xlPrevious).Row - 1
        If Rng.Offset(i, 1) <> 100 Then
            Set recal = .Columns(1).Find(Rng.Offset(i, 0), LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1)
            'MsgBox (100 - Rng.Offset(i, 1))
            recal = recal + (100 - Rng.Offset(i, 1))
        End If
    Next i
 
    'Et on ré-affiche les valeurs !
    ReDim table(1 To 2, 1 To 1)
    calcul_col (col + 2)
End With
 
End Sub
 
Function calcul_col(col As Integer)
'Décaration des variables
Dim Rng As Range
Dim flag As Boolean
 
'Avec la feuille "Feuil1"
With Worksheets("Feuil1")
    'On set Rng sur A1
    Set Rng = .Range("A1")
 
    'On initialise le tableau
    table(1, 1) = Rng.Offset(1, 0)
    table(2, 1) = Rng.Offset(1, 1)
 
    'On passe sur l'ensemble des cellules non-vides de la colonne A
    For i = 2 To .Columns(1).Find("*", , , , , xlPrevious).Row
        'A chaque occurence on vérifie si l'ID n'est pas présent dans notre tableau
        For j = LBound(table, 2) To UBound(table, 2)
            'On set le flag à False tout le temps
            flag = False
 
            'Si on trouve un ID identique, on passe le flag à True
            If Rng.Offset(i, 0) = table(1, j) Then
                flag = True
                Exit For
            End If
        Next j
 
        'Si le flag est à True
        If flag Then
            'On additionne l'ancienne valeur avec celle trouvée
            table(2, j) = table(2, j) + Rng.Offset(i, 1)
        'Sinon...
        Else
            '... on ajoute une entrée au tableau et on insère les valeurs
            ReDim Preserve table(1 To 2, 1 To UBound(table, 2) + 1)
            table(1, UBound(table, 2)) = Rng.Offset(i, 0)
            table(2, UBound(table, 2)) = Rng.Offset(i, 1)
        End If
    Next i
 
    'Enfin, on se positionne sur la ligne 1 en colonne définie en entrée
    Set Rng = .Cells(1, col)
 
    'On écrit la table sur les cellules correspondantes
    For j = LBound(table, 2) To UBound(table, 2)
        Rng.Offset(j, 0) = table(1, j)
        Rng.Offset(j, 1) = table(2, j)
    Next j
End With
 
End Function

Ca place tes résultats sur les colonnes H et I à la première boucle et J et K sur la seconde (étant une vérification si on a bien 100% partout).

Voili, voilou !

Cordialement,
Kimy

EDIT : avec les commentaires

Si la somme des valeurs de l'individus est différent de 100, imputer la différence pour obtenir 100.

Macros et VBA Excel

Discussions similaires

Partager

Partager