Discussion :

[Isabelle86]

Bonjour!

J'essaie de trouver une macro qui me permet de:

- Dans la feuille 3, les cellules de la première ligne possèdent des titres distincts (correspondants, p.ex à des noms de différentes familles).
- Dans la feuille 2, ma colonne B contient ces noms de famille (plusieurs cellules ont le même nom de famille) et à chaque nom, correspond dans la colonne J des valeurs.

Je voudrais que dans la ligne 160 de la feuille 3, à chaque famille (donc à chaque colonne) avoir la somme des éléments de la colonne D de la feuille 2 correspondant à chaque famille (donc colonne B) SI les valeurs de la colonne J correspondante sont non nulles.

Voila ce que j'ai écrit mais cela bug à la ligne en gras: "type mismatch". Je ne sais pas non plus si mon code est exact...

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
Dim i As Integer
Dim j As Integer
Dim x As Double
Dim cell As Range

For j = 2 To LastCol
    x = 0
    For i = 4 To LastLig
        For Each cell In Sheets("KEYS").Cells(i, 2)
        If cell.Value = Sheets(3).Cells(1, j) Then
            If Sheets("KEYS").Cells(i, 10).Value <> 0 Then
            x = x + Sheets("KEYS").Cells(i, 4).Value
            End If
            End If
        Next cell
    Next i
    .Cells(160, j).Value = x
    Next j

[pgz]

Bonjour.

Je ne sais pas ce qui provoque l'arrêt en erreur, mais il y a quelques pb.
EN premier lieu, on ne voit pas comment tu renseignes LastList et LastCol.
Ensuite, la scrutation

Code :

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

1
2
3
For Each cell In Sheets("KEYS").Cells(i, 2)
           ...        
Next cell

ne sert à rien : dans la cellule (i,2) il n'y a qu'une cellule.
De plus, la ligne

Code :

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

.Cells(160, j).Value = x

n'est pas complète : il n'y a rien devant le point.
Fais aussi attention à l'indentation du code qui n'est pas parfaite.
Avec tout cela, cela donne

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
Sub Isa()
 
Dim i As Integer
Dim j As Integer
Dim x As Double
Dim cell As Range
 
Const LastCol As Integer = 5 'ligne à remplacer
Const LastLig As Integer = 9 'ligne à remplacer
 
For j = 2 To LastCol
    x = 0
    For i = 4 To LastLig
        If Worksheets("KEYS").Cells(i, 2).Value = Worksheets(3).Cells(1, j).Value Then
            If IsNumeric(Worksheets("KEYS").Cells(i, 10).Value) Then
                x = x + Worksheets("KEYS").Cells(i, 10).Value
            End If
        End If
    Next i
    Worksheets(3).Cells(160, j).Value = x
Next j
 
End Sub

Cordialement,

PGZ

[Isabelle86]

Merci pour la réponse, mais malheureusement, à la ligne

Code :

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

        If Worksheets("KEYS").Cells(i, 2).Value = Worksheets(3).Cells(1, j).Value Then

il me dit "run-time error 13 type mismatch". Sans doute parce qu'on compare en fait deux mots?

[pgz]

Re,

Dans la colonne B de la feuille 2 entre la ligne 4 et la ligne LastLig toutes les cellules contiennent bien du texte?
Mêle question pour la ligne 1 de la feuille 3 entre la col 2 et la col LastCol?
Quand l'erreur survient, tu peux ouvrir le debug et regrader combien vallent i et j.
Tu as quelle version d'Excel?

PGZ

[Isabelle86]

J'ai Excel 2003.

En effet, la colonne 2 de la feuille 1 et la première ligne de la feuille 3 contiennent du texte.
Mais en regardant la valeur de i, j'ai remarqué qu'en fait, il bloque parce qu'il arrive à une cellule #N/A. Comment faire pour que la macro n'en tienne pas compte et passe à la ligne suivante?

[pgz]

Bonjour.

Tu peux tester la cellule. Cela donne :

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
Sub Isa()
 
Dim i As Integer
Dim j As Integer
Dim x As Double
Dim cell As Range
 
Const LastCol As Integer = 5 'ligne à remplacer
Const LastLig As Integer = 9 'ligne à remplacer
 
For j = 2 To LastCol
    x = 0
    For i = 4 To LastLig
        If Not IsError(Worksheets("KEYS").Cells(i, 2).Value) Then
            If Worksheets("KEYS").Cells(i, 2).Value = Worksheets(3).Cells(1, j).Value Then
                If IsNumeric(Worksheets("KEYS").Cells(i, 10).Value) Then
                    x = x + Worksheets("KEYS").Cells(i, 10).Value
                End If
            End If
        End If
    Next i
    Worksheets(3).Cells(160, j).Value = x
Next j
 
End Sub

Bonne journée,

PGZ

[Isabelle86]

Génial, tout fonctionne!

Merci beaucoup!