Discussion :

[Cohenpi]

Bonjour à tous,

Cette macro est fonctionnelle mais évidemment très lente.

Existe-t-il une autre façon de procéder ?

(4 colonnes : La première = séquence; la deuxième = qté; la troisième = séquence; la quatrième = qté -> Le but étant de trouver les mêmes référence dans les colonnes 1 et 3 et de soustraire leur quantité respectives. Ensuite on colle la référence en colonne 6 avec le résultat de la soustraction en colonne 7)

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
Sub reper_idem_soustraction()  
    Application.ScreenUpdating = False
    dernLigne = ActiveCell.SpecialCells(xlLastCell).Row
    Dim Plage As Range
    i = 1
    Do While (i < 2350)
        j = 1
        t = 0
        Do While (j < 1663 And t = 0)
            If (Range("A" & i).Value = Range("C" & j).Value) Then
                Range("F" & i).Value = Range("A" & i).Value
                Range("G" & i).Value = Range("B" & i).Value - Range("D" & j).Value
                t = 1
            End If
            j = j + 1
        Loop
        i = i + 1
    Loop
    Application.ScreenUpdating = True
End Sub

Merci !

[a.dequidt]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim max As Integer
Dim i As Integer
max = ActiveCell.SpecialCells(xlLastCell).Row
For i = 1 To max
    If Cells(i, 1).Value = Cells(i, 3).Value Then
        Cells(i, 6).Value = Cells(i, 1).Value
        If Cells(i, 2).Value > Cells(i, 4).Value Then
            Cells(i, 7).Value = Cells(i, 2).Value - Cells(i, 4).Value
        Else
            Cells(i, 7).Value = Cells(i, 4).Value - Cells(i, 2).Value
        End If
    End If
Next i

tu testes tu dis

[Drost]

Hello,

En fait tu souhaites soustraires deux quantités lorsques deux références sont identiques et d'en coller le résultat avec la référence dans d'autre colonne?

Je te propose de passer par des tableaux croisés dynamiques (un pour chacune des deux variables). tu pourra alors via une recherchev alors faire ta soustraction, il te faudra cependant que tu liste d'abord toutes tes références...

Je ne sais pas si cela sera plus rapide que ta macro mais ca vaut peut etre la peine d'essayer!

PS : N'oublie pas d'enlever la fonction de calcul automatique^^

Tchuss

[Gorfael]

Salut
Existe-t-il une autre façon de procéder ?
Bien sur, t'es sur Excel !

Comme tu ne donnes pas beaucoup d'infos, c'est dur de trouver un meilleur code !
Mais déjà, une remarque : à quoi peu bien te servir dernLigne ? C'est bien de trouver la dernière ligne utilisée dans ta feuille, mais c'est mieux de l'utiliser !

Comme je ne connais pas le contenu des colonnes, un peu de logique : si tu as X fois la même valeurs dans A, tu ôteras X fois la valeur correspondant à la première référence trouvée en C. C'est bien le but ?

Ton idée de T1 est pas mal mais : A1=C1 => j'inscrit une ligne en F1/G1, je mets T1=1 et je fais 1662 test qui seront faux, puisque T1<>0 ?!?

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
Sub reper_idem_soustraction()  
dim i as long
dim j as long
    Application.ScreenUpdating = False
    i = 1
    Do While (i < 2350) or (i<[A65536].end(xlup).row)
        j = 1
        Do While (j < 1663) or (j<[C65536].end(xlup).row)
            If (Range("A" & i).Value = Range("C" & j).Value) Then
                Range("F" & i).Value = Range("A" & i).Value
                Range("G" & i).Value = Range("B" & i).Value - Range("D" & j).Value
                exit Do
            End If
            j = j + 1
        Loop
        i = i + 1
    Loop
    Application.ScreenUpdating = True
End Sub

I et J sont limités soit par la valeur donnée (2350 et 1663) soit par la fin des valeurs de la colonne (A et C)
Si on rencontre une valeur identique à A en C, on s'occupe de F et G et on passe à A suivant
Par contre, si j'ai 2 fois la même valeur en C, la seconde ne sera jamais traitée
A+
EDIT : y'en a qui ont profité de ma lenteur pour répondre. Mais je reviendrai et ma réponse sera la plus rapide.
L'histoire de passer par des formules est une bonne idée.
Pour la recherche en C, le passage par un .Find serait plus rapide, mais j'ai préféré rester sur du code connu.

P'tite vengeance pour m'avoir grillé :
Aurore : tu ne testes que l'égalité entre A et C de la même ligne ? Plus rapide, mais moins utiles yerk, yerk, yerk
Plus dur de jongler avec cells pour ne pas faire d'erreur de numéro de colonne => Je préfère utiliser Range

Drost :
F1 : =SI(OU(ESTNA(RECHERCHEV(A1;$C$1:$D$1663;1;0));A1="");"";A1)
G1 : =SI(F1="";"";B1-RECHERCHEV(A1;$C$1:$D$1663;2;0))
à recopier jusqu'à la ligne 2350

[Cohenpi]

Aurore, comme l'a dit Gorfael, avec ta fonction c'est plus rapide mais moins utile et surtout on n'arrivera pas au résultat escompté.

Pour Gorfael, j'ai oublié de dire qu'il n'y aura jamais de doublons en C, donc pas de souci.

Pour le coup de la dernière ligne, je l'ai utilisée dans la fonction à un moment et puis plus et j'ai zappé de virer l'instruction

Sinon, merci pour le

Code :

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

exit Do

, mais cela revient en même que mon t qui devient 1, car quand t devient 1, on sort de la boucle (et on ne fait pas x tests faux )

Donc résultat, le temps pris par cette macro est toujours aussi long pour le moment...

[Gorfael]

Salut
C'est vrai (bien la peine de me moquer d'Aurore : je suis pas mieux)
J'utilise jamais While, et donc, j'ai mal analysé l'instruction . Mais à quoi ça me sert d'être bête si je ne le montre pas, hein !

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
 
Sub reper_idem_soustraction()
Dim i As Long
Dim Cel As Range
    Application.ScreenUpdating = False
    i = 1
    Do While (i < 2350) Or (i < [A65536].End(xlUp).Row)
        Set Cel = Range([C1], [C65536].End(xlUp)).Find(Range("A" & i), LookIn:=xlValues)
        If Not (Cel Is Nothing) Then
            Range("F" & i) = Range("A" & i)
            Range("G" & i) = Range("B" & i) - Cel.Offset(0, 1)
        End If
        i = i + 1
    Loop
    Application.ScreenUpdating = True
End Sub

devrait être un peu plus rapide
A+

[Cohenpi]

En effet !

Merci à toi