Macro VBA problème bizzare

**ANTMA** · 13/12/2007, 15h18

Bonjour,

j'ai fait une macro pour pouvoir calculer des sommes en fonction de variables mais je ne comprends pas il me marque un débogage (j'ai réutilisé une macro qui faisait des sommes en évitant de prendre en compte les doublons de classe) .

Je veux juste faire une somme si ma date et ma ref de ma feuil Data Global est égale à ma date et ma ref de ma feuil data prototype alors je fais une somme des valeurs de mes classes situé dans la colonne 6 de ma feuil data prototype et j'affiche le résultat dans ma colonne 10 de ma feuil data global

Voici mon code et la ligne en rouge est la ligne ou il y a un débogage

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
Sub test()
    Dim i As Long
    Dim j As Long
    Dim wksCriteres As Worksheet
    Dim rngDataDate As Range
    Dim wksCopie As Worksheet
    Dim c As Range
    
    Set wksCriteres = Worksheets("Critères")
    Set wksCopie = Worksheets("Copie")
    
    ' Trouver le titre de la colonne dans la page de données globales
    Set rngDataDate = Worksheets("Data Global").UsedRange.Columns(1).Find(What:="Date")
    If Not rngDataDate Is Nothing Then            ' trouvé!
        ' on commence l'itération à la ligne suivante...
        i = 1
        While Not IsEmpty(rngDataDate.Offset(i, 0).Value)
            ' filtrer la table de prestation en fonction de la date et ref
            wksCriteres.Range("A2").Value = rngDataDate.Offset(i, 0).Value ' 0 colonne 'Date'
            wksCriteres.Range("B2").Value = rngDataDate.Offset(i, 1).Value ' 1 colonne à droite 'Ref'
            Worksheets("Data prototype").UsedRange.AdvancedFilter Action:=xlFilterCopy, _
                                    CriteriaRange:=wksCriteres.Range("A1:B2"), _
                                    CopyToRange:=wksCopie.Range("A1"), _
                                    Unique:=True
            For j = 2 To wksCopie.UsedRange.Rows.Count
                rngDataDate.Offset(i, 7).Value = rngDataDate.Offset(i, 7).Value + wksCopie.UsedRange.Cells(j, 6).Value
            Next j
            wksCopie.Cells.Delete
            i = i + 1
        Wend
    End If
End Sub

Merci du coup de main

**ANTMA** · 13/12/2007, 17h39

Ben si mon adresse de départ c'est

Code :

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

1
2
3
4
5
 Worksheets("Data prototype").UsedRange.AdvancedFilter Action:=xlFilterCopy, _
                                    CriteriaRange:=wksCriteres.Range("A1:B2"), _
                                    CopyToRange:=wksCopie.Range("A1"), _
                                    Unique:=True
            For j = 2 To wksCopie.UsedRange.Rows.Count

**ANTMA** · 13/12/2007, 18h53

En fait je veux faire la somme des valeurs de mes classes en fonction de mes dates et de mes ref

Voici comment se présente ma Feuil Data prototype:
colonne1 2 5 6
24/11/07 FF0006 J 58.
24/11/07 FF0006 P 55.456052
24/11/07 FF0006 Y 23778
24/11/07 GH0008 J 3424
24/11/07 GH0008 P 2402
24/11/07 GH0008 Y 23
24/11/07 ZZ0010 J 8058
24/11/07 ZZ0010 Y 234
24/11/07 ZY0018 J 2732
24/11/07 ZY0018 Y 1,00
24/11/07 ZP0022 J 1602
24/11/07 ZP0022 P 5352

et Voici comment se présente ma feuil data Global

colonne1 2 8
24/11/07 FF0006 ici somme des valeurs pour la mm date et ref 24/11/07 GH0008
24/11/07 ZZ0010
24/11/07 ZY0018
24/11/07 ZP0022

**ouskel'n'or** · 14/12/2007, 01h42

Tu as raison, autant pour moi. Alors je ne vois pas.

Désolé

**ouskel'n'or** · 14/12/2007, 10h37

Une question bête : Tu n'as pas de ligne ou colonne vide dans ta plage de données ?
Vérifie où te place ta ligne de code avec un select

Code :

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

rngDataDate.Offset(i, 7).Select

et avec

Code :

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

wksCopie.UsedRange.Cells(j, 6).Select

A tout hasard

**ANTMA** · 14/12/2007, 12h02

Il met débogage à a ce niveau , coprends pas

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
Sub test()
    Dim i As Long
    Dim j As Long
    Dim wksCriteres As Worksheet
    Dim rngDataDate As Range
    Dim wksCopie As Worksheet
    Dim c As Range
    
    Set wksCriteres = Worksheets("Critères")
    Set wksCopie = Worksheets("Copie")
    
    ' Trouver le titre de la colonne dans la page de données globales
    Set rngDataDate = Worksheets("Data Global").UsedRange.Columns(1).Find(What:="Date")
    If Not rngDataDate Is Nothing Then            ' trouvé!
        ' on commence l'itération à la ligne suivante...
        i = 1
        While Not IsEmpty(rngDataDate.Offset(i, 0).Value)
            ' filtrer la table de prestation en fonction de la date et ref
            wksCriteres.Range("A2").Value = rngDataDate.Offset(i, 0).Value ' 0 colonne 'Date'
            wksCriteres.Range("B2").Value = rngDataDate.Offset(i, 1).Value ' 1 colonne à droite 'Ref'
            Worksheets("Data prototype").UsedRange.AdvancedFilter Action:=xlFilterCopy, _
                                    CriteriaRange:=wksCriteres.Range("A1:B2"), _
                                    CopyToRange:=wksCopie.Range("A1"), _
                                    Unique:=True
            For j = 2 To wksCopie.UsedRange.Rows.Count
            rngDataDate.Offset(i, 7).Select
            wksCopie.UsedRange.Cells(j, 6).Select
                rngDataDate.Offset(i, 7).Value = rngDataDate.Offset(i, 7).Value + wksCopie.UsedRange.Cells(j, 6).Value
            Next j
            wksCopie.Cells.Delete
            i = i + 1
        Wend
    End If
End Sub

**ouskel'n'or** · 14/12/2007, 13h25

Remplace

rngDataDate.Offset(i, 7).Select

par

Code :

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

            Range(rngDataDate.address).Offset(i, 7).Select

rngDataDate tout court contient la valeur trouvée, pas l'adresse de cette valeur.

**ANTMA** · 14/12/2007, 13h39

Il m'affiche $A$13 lorsque je mets ce code

Code :

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

 Range(rngDataDate.Address).Offset(i, 7).Select

mais apres j'ai un debogage sur cette ligne

Code :

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

rngDataDate.Offset(i, 7).Value = rngDataDate.Offset(i, 7).Value + wksCopie.UsedRange.Cells(j, 6).Value

**Qwazerty** · 14/12/2007, 13h46

SAlut
Humm désolé pas d'accord avec toi Offset renvoi bien un type range et le select devrait fonctionner.
Donne nous voir un fichier avec matiere a travailler s'il te plait par ce que ca doit venir d'ailleur ton probleme
Quel est le message d'erreur pour la ligne

Code :

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

rngDataDate.Offset(i, 7).Select

?

A++
Qwaz

**ouskel'n'or** · 14/12/2007, 14h03

Envoyé par ANTMA

Il m'affiche $A$13 lorsque je mets ce code

Code :

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

 Range(rngDataDate.Address).Offset(i, 7).Select

mais apres j'ai un debogage sur cette ligne

Code :

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

rngDataDate.Offset(i, 7).Value = rngDataDate.Offset(i, 7).Value + wksCopie.UsedRange.Cells(j, 6).Value

Alors corrige ta ligne en utilisant le code que je t'ai passé

Code :

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

Range(rngDataDate.Address).Offset(i, 7).Value = Range(rngDataDate.Address).Offset(i, 7).Value + wksCopie.UsedRange.Cells(j, 6).Value

**ANTMA** · 14/12/2007, 14h06

Voici un fichier exemple de ce que je cherche à faire

Par avance merci de votre aide

**ouskel'n'or** · 14/12/2007, 14h09

Tu as testé ce que je t'ai mis juste en dessus ?

**Qwazerty** · 14/12/2007, 14h29

Re
Bonj'ai compris
Donc comme je le dis plus haut pas de probleme avec Offset ca renvoi bien un range
Ton soucis est tout ailleur...
Dans ta derniere colonne les valeur numeric qui y sont saisies ne sont pas au bon format car attention 51.654 et 51,654 ca n'est pas la meme chose en fonction des mparametre windows local, fait une petite recherche sur le forum tu va trouver ce qu'il faut pour convertir.
A++
Qwaz

**ANTMA** · 14/12/2007, 18h56

Les deux solutions ne marchent pas, j'ai bien modifié mais chiffres mais la macro ne marche pas quand même et j'ai aussi modifié le code et j'ai toujours un débogage (ligne en rouge)

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
Sub test()
    Dim i As Long
    Dim j As Long
    Dim wksCriteres As Worksheet
    Dim rngDataDate As Range
    Dim wksCopie As Worksheet
    Dim c As Range
    
    Set wksCriteres = Worksheets("Critères")
    Set wksCopie = Worksheets("Copie")
    
    ' Trouver le titre de la colonne dans la page de données globales
    Set rngDataDate = Worksheets("Data Global").UsedRange.Columns(1).Find(What:="Date")
    If Not rngDataDate Is Nothing Then            ' trouvé!
        ' on commence l'itération à la ligne suivante...
        i = 1
        While Not IsEmpty(rngDataDate.Offset(i, 0).Value)
            ' filtrer la table de prestation en fonction de la date et ref
            wksCriteres.Range("A2").Value = rngDataDate.Offset(i, 0).Value ' 0 colonne 'Date'
            wksCriteres.Range("B2").Value = rngDataDate.Offset(i, 1).Value ' 1 colonne à droite 'Ref'
            Worksheets("Data prototype").UsedRange.AdvancedFilter Action:=xlFilterCopy, _
                                    CriteriaRange:=wksCriteres.Range("A1:B2"), _
                                    CopyToRange:=wksCopie.Range("A1"), _
                                    Unique:=True
            For j = 2 To wksCopie.UsedRange.Rows.Count
            Range(rngDataDate.Address).Offset(i, 7).Value = Range(rngDataDate.Address).Offset(i, 7).Value + wksCopie.UsedRange.Cells(j, 6).Value                
            Next j
            wksCopie.Cells.Delete
            i = i + 1
        Wend
    End If
End Sub

je sais pas trop comment faire ????

**Qwazerty** · 14/12/2007, 19h04

Re
Donne le message d'erreur

Un bon reflexe a prendre et de typé les contenu des cellule au moment de leur utilisation, je sais qu'en VB c'est pas toujours obligatoire mais je pense que c'est un bon reflexe, ca permet de savoir ce que l'on attend de son code

Code :

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

1
2
 
rngDataDate.Offset(i, 7).Value = CDbl(rngDataDate.Offset(i, 7).Value) + CDbl(wksCopie.UsedRange.Cells(j, 6).Value)

Mais dans ce cas meme sans CDlg() ca fonctionne chez moi sur le fichier que tu as donné, es tu sur de ne rien faire d'autre
Donne le code que tu as modifié

[Edit]Je sais pas pourquoi mais UsedRange ca me dis rien qui vaille, Je vois pas l'interet notement ici

Code :

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

1
2
 
rngDataDate.Offset(i, 7).Value = CDbl(rngDataDate.Offset(i, 7).Value) + CDbl(wksCopie.Cells(j, 6).Value)

Et dans ce code appart si tu mùet pas les bonne données dans les cellules je vois pas ce qui cloche desolé, donc j'attend ton code

[/Edit]

A++
Qwaz

**ANTMA** · 15/12/2007, 14h09

Ca ne marche pas je comprends vraimant pas.

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
Sub test()
    Dim i As Long
    Dim j As Long
    Dim wksCriteres As Worksheet
    Dim rngDataDate As Range
    Dim wksCopie As Worksheet
    Dim c As Range
    
    Set wksCriteres = Worksheets("Critères")
    Set wksCopie = Worksheets("Copie")
    
    ' Trouver le titre de la colonne dans la page de données globales
    Set rngDataDate = Worksheets("Data Global").UsedRange.Columns(1).Find(What:="Date")
    If Not rngDataDate Is Nothing Then            ' trouvé!
        ' on commence l'itération à la ligne suivante...
        i = 1
        While Not IsEmpty(rngDataDate.Offset(i, 0).Value)
            ' filtrer la table de prestation en fonction de la date et ref
            wksCriteres.Range("A2").Value = rngDataDate.Offset(i, 0).Value ' 0 colonne 'Date'
            wksCriteres.Range("B2").Value = rngDataDate.Offset(i, 1).Value ' 1 colonne à droite 'Ref'
            Worksheets("Data prototype").UsedRange.AdvancedFilter Action:=xlFilterCopy, _
                                    CriteriaRange:=wksCriteres.Range("A1:B2"), _
                                    CopyToRange:=wksCopie.Range("A1"), _
                                    Unique:=True
            For j = 2 To wksCopie.UsedRange.Rows.Count
                rngDataDate.Offset(i, 7).Value = CDbl(rngDataDate.Offset(i, 7).Value) + CDbl(wksCopie.Cells(j, 6).Value)
            Next j
            wksCopie.Cells.Delete
            i = i + 1
        Wend
    End If
End Sub

si tu peux m'envoyer le fichier Excel que tu as réussi à faire marché

**LeForestier** · 15/12/2007, 14h57

Bonjour,
Chez moi aussi ta fonction 'fonctionne' bien. (Vista)
Mais tu à un problème dans la feuille 'Data Prototype' colonne Valeurs, la majorité est entrée avec un point pour les décimales et cela devrait être une virgule.
Tu a probablement un dépacement de capacité en fonction de ton PC ou de sa configuration. (il y à des résultats qui dépasse les 100 milliard)
Mais il est vrai que si ça 'Bugge' chez toi tu ne pouvais pas le constater.
A+
Edit: Il n'y à rien a changer dans la fonction.
Edit2: Mais je doute fort que les résultats soient ceux que tu attend.

**ANTMA** · 15/12/2007, 15h41

mais j'ai changé les chiffres et je les ai mis avec des virgules et ça ne marche pas quand même.

De plus les ciffres que j'ai mis dans l'exemple ne sont pas les bons

et mon pac fonctionne avec XP et excel 2003

**ANTMA** · 15/12/2007, 15h51

Pouvez vous m'envoyez votre fichier avec le code ??

Merci

**LeForestier** · 15/12/2007, 17h02

Je ne sais pas comment ces nombres sont entrés mais je n'ai pas eu façile de les convertir.
Une sub est ajoutée au cas ou il y aurait beaucoup de valeurs à modifier.
J'ai aussi ajouté l'effacement de la plage où les données sont affichées vu que tu les ajoute à ce qui se trouve dans ces cellules.
Le fichier est joint..
A+

Macro VBA problème bizzare

Macros et VBA Excel

Discussions similaires

Partager

Partager