Différence de somme de quantités en VBA

Version imprimable

22/12/2014, 22h53
Hajoorita

1 pièce(s) jointe(s)

Différence de somme de quantités en VBA

Bonjour tout le monde ,
je suis débutante en VBA et je dévéloppe un petit code qui facilite la détection des écarts des quantités en feuille 1 et feuille 2 .
Disant que dans la feuille 1 j'ai
Ref Quantité
705-101-102 5000
705-123-123 1000
705-101-102 6000
Dans la feuille 2 j'ai :
705-101-102 5000
705-123-123 1000
705-123-123 9000

Donc dans la feuille 3 je veux :
705-101-102 (5000+6000) - 5000 = 6000
705-123-123 1000 - ( 1000 + 9000) = -9000

Merci de trouver ci-joint le fichier excel.

Bonjour Hajoorita,

Voici ce que je te propose.

Code:

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
Option Explicit
 
Sub Hajoorita()
Dim rng As Range
Dim oTable() As String
Dim bool As Boolean
Dim i As Integer, j As Integer
 
With Worksheets("F1")
    Set rng = .Range("A2")
    ReDim oTable(1 To 2, 1 To 1)
 
    oTable(1, 1) = rng
    oTable(2, 1) = rng.Offset(0, 1)
 
    For i = 1 To .Columns(1).Find("*", , , , , xlPrevious).Row - 2
        bool = True
        For j = LBound(oTable, 2) To UBound(oTable, 2)
            If oTable(1, j) = rng.Offset(i, 0) Then
                oTable(2, j) = oTable(2, j) + rng.Offset(i, 1)
                bool = False
                Exit For
            End If
        Next j
 
        If bool Then
            ReDim Preserve oTable(1 To 2, 1 To UBound(oTable, 2) + 1)
            oTable(1, UBound(oTable, 2)) = rng.Offset(i, 0)
            oTable(2, UBound(oTable, 2)) = rng.Offset(i, 1)
        End If
    Next i
End With
 
With Worksheets("F2")
    Set rng = .Range("A1")
 
    For i = 1 To .Columns(1).Find("*", , , , , xlPrevious).Row - 1
        bool = True
        For j = LBound(oTable, 2) To UBound(oTable, 2)
            If oTable(1, j) = rng.Offset(i, 0) Then
                oTable(2, j) = oTable(2, j) - rng.Offset(i, 1)
                bool = False
                Exit For
            End If
        Next j
 
        If bool Then
            ReDim Preserve oTable(1 To 2, 1 To UBound(oTable, 2) + 1)
            oTable(1, UBound(oTable, 2)) = rng.Offset(i, 0)
            oTable(2, UBound(oTable, 2)) = -rng.Offset(i, 1)
        End If
    Next i
End With
 
With Worksheets("F3")
    .Range("A2:B" & .Columns(2).Find("*", , , , , xlPrevious).Row).Clear
    Set rng = .Range("A1")
 
    For j = LBound(oTable, 2) To UBound(oTable, 2)
        rng.Offset(j, 0) = oTable(1, j)
        rng.Offset(j, 1) = oTable(2, j)
    Next j
End With
 
End Sub

Je n'ai pas fait toutes les vérifications mais il me semble que ça fonctionne.
N'hésite pas à revenir vers moi pour tout complément.

Petite précision, je "clear" la Feuil3 (ou "F3" dans mon exemple) avant d'insérer les valeurs.
Fais moi un retour. :ccool:

Cordialement,
Kimy

23/12/2014, 12h17
Hajoorita

1 pièce(s) jointe(s)

Bonjour Kimy :)
Je vous remercie infiniment pour votre effort. Lorsque j'ai essayé votre code , il m'a affiché que le nombre 1.
En fait j'ai trouvé un code qui marche parfaitement mais je veux l'améliorer en coloriant les références qui se trouvent dans la feuille "Quantité papier" et pas dans la feuille " Quantité Physique" , mais en les copiant dans "Ecart" . De plus , je veux que lorsque le macro de calcul des écarts est exécuté , A la fin de calcul la feuille sera protégée , et lorsque je clique sur le bouton "ajouter des commentaires" seule la plage de cellules "C" sera déprotégée !
Et de plus , - excusez moi :oops: - je ne veux pas que la forme de cellules de feuille "Ecart" soit changée !
Merci de trouver ci-joint le fichier actuel !
:oops: