Discussion :

[deaqu1]

Bonsoir à tous,
je tiens tout d'abord à m'excuser si mon code vous parait "babare", je ne suis pas un pro d'excel, et j'essaye de me souvenir de mes bases en VB et Access...Que C difficile...
Alors je vous explique:
Sur ma page 1, j'ai une liste de produit sur la colonne A, associé à une valeur sur B.
Je voudrais "compiler", "extraire" ces données et les envoyer sur la page 2 en additionnant les valeurs correspondantes à un même article.

Voici mon code:

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
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim intCompteur As Integer
Dim intValue As Integer
Dim strReference As String
Dim boolTest As Boolean
 
 
For intI = 1 To 7
    'initialisation des variables
    boolTest = False
    intCompteur = 0
    intValue = 0
 
    'Mise en mémoire des données collectées dans la feuille n°1
    Sheets("Feuil1").Select
    strReference = Range("A" & intI).Value
    intValue = Range("B" & intI).Value
 
 
    'Comptage du nombre de référence dans la bibliothéque
    Sheets("Feuil2").Select
    For intJ = 1 To 20
        If ActiveSheet.Range("A" & intJ).Value <> "" Then
            '---------------------------------------------
            TEST = ActiveSheet.Range("A" & intJ).Value
            '---------------------------------------------
            intCompteur = intCompteur + 1 'Nb de référence
        End If
    Next intJ
 
    'Parcours de la bibliothéque de référence
    For intK = 1 To intCompteur
        'La référence se trouve à l'intérieure
        '---------------------------------------------
        TEST1 = ActiveSheet.Range("A" & intK).Value
        '---------------------------------------------
        If strReference = ActiveSheet.Range("A" & intK).Value Then
            ActiveSheet.Range("B" & intK).Value = ActiveSheet.Range("B" & intK).Value + intValue
            boolTest = True
        End If
    Next intK
 
    'la référence n'est pas à l'intérieur & on se place à la queue
    If boolTest = False Then
        ActiveSheet.Range("A" & intCompteur + 1).Value = strReference
        ActiveSheet.Range("B" & intCompteur + 1).Value = intValue
    End If
 
 
Next intI

Comment faire pour l'améliorer:
- Le basculement page1 - page 2 lorsque l'on appuie sur le bouton
- diminuer le temps d'excécution, car là je scute 7 lignes, mais à terme il il y en aurait prés de 1000...et le temps de calcul est long...


Merci de votre aide...

[SilkyRoad]

bonjour

J'espère que cette procédure pourra t'aider.
Il existe d'autres solutions. C'est un exemple parmi d'autres.

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
Dim i As Integer, j As Integer
Dim Cell As Range
Dim Un As Collection
Dim Plage As Range, SommePlage As Range
 
Set Un = New Collection
 
'Recherche le numéro de ligne pour la dernière cellule
'non vide dans la colonne A.
i = Worksheets("Feuil1").Range("A65536").End(xlUp).Row
Set Plage = Worksheets("Feuil1").Range("A1:A" & i)
Set SommePlage = Worksheets("Feuil1").Range("B1:B" & i)
 
'Boucle sur les données de la colonne A
For Each Cell In Plage
    On Error Resume Next
    'Crée une collection sans doublons
    Un.Add Cell, CStr(Cell)
Next Cell
On Error GoTo 0
 
'Boucle sur la collection
For j = 1 To Un.Count
    Worksheets("Feuil2").Cells(j, 1) = Un(j)
    'Effectue la somme en fonction du critère (SOMME.SI)
    Worksheets("Feuil2").Cells(j, 2) = _
        Application.WorksheetFunction.SumIf(Plage, Un(j), SommePlage)
Next j

michel

[deaqu1]

Je n'ai qu'un mot à dire: MERCI