Bonjour à tous,
J'ai un souci avec un fichier excel. J'ai une colonne ligne (A),OF (colonne B) et temps (colonne C). L'objectif est de créer un autre tableau dans le lequel je n'ai plus d'OF en doublons. Par contre, si j'ai plusieurs numéro d'OF identiques, je somme la valeur des temps du meme OF avant de supprimer les doublons.
J'ai actuellement une macro qui me fait ça très bien, mais uniquement en considérant deux colonnes (OF et temps). Je souhaites maintenant intéger une troisième colonne à cette macro, mais je n'y arrive pas.
Merci d'avance pour vos réponses
Sub somme()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim s As Double 'déclare la variable s (Somme)
Dim dest As Range 'déclare la variable dest (DESTination)
Set pl = Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row) 'définit la plage pl
For Each cel In pl 'boucle sur toutesm les cellules éditées cel de la plage pl
s = 0 'définit la variable s
If cel.Font.ColorIndex <> 5 Then 'condition 1 : si l'encre de la cellule n'est pas bleue
'condition 2 : si le nombre de valeur de la cellule dans pla plage pl est supérieur à un
If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
Set r = pl.Find(cel.Value, , xlValues, xlWhole) 'définit la variable r
If Not r Is Nothing Then
pa = r.Address 'si il existe au moins une occurrence de r dans pl définit la variable pa
r.Font.ColorIndex = 5 'met l'encre bleue dans l'occurrence trouvée
End If
Do 'exécute
Set r = pl.FindNext(r) 'redéfinit la variable r (prochaine occurrence)
r.Font.ColorIndex = 5 'met l'encre bleue dans la nouvelle occurrence
s = s + CDbl(r.Offset(0, 1).Value) 'redéfinit la variable s
Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
Else 'sinon (condition 2)
s = CDbl(cel.Offset(0, 1).Value) 'définit la variable s
End If 'fin de la condition 2
Set dest = Sheets("Feuil1").Range("D65536").End(xlUp).Offset(1, 0) 'définit la variable dest
dest.Value = cel.Value 'récupère le numéro OF
dest.Offset(0, 1).Value = s 'récupère la somme
End If 'fin de la condition1
Next cel 'prochaine cellule de la plage
pl.Font.ColorIndex = 1 'remet la couleur d'encre noire dans la plage pl
End Sub
J'ai un souci avec un fichier excel. J'ai une colonne ligne (A),OF (colonne B) et temps (colonne C). L'objectif est de créer un autre tableau dans le lequel je n'ai plus d'OF en doublons. Par contre, si j'ai plusieurs numéro d'OF identiques, je somme la valeur des temps du meme OF avant de supprimer les doublons.
J'ai actuellement une macro qui me fait ça très bien, mais uniquement en considérant deux colonnes (OF et temps). Je souhaites maintenant intéger une troisième colonne à cette macro, mais je n'y arrive pas.
Merci d'avance pour vos réponses
Sub somme()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim s As Double 'déclare la variable s (Somme)
Dim dest As Range 'déclare la variable dest (DESTination)
Set pl = Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row) 'définit la plage pl
For Each cel In pl 'boucle sur toutesm les cellules éditées cel de la plage pl
s = 0 'définit la variable s
If cel.Font.ColorIndex <> 5 Then 'condition 1 : si l'encre de la cellule n'est pas bleue
'condition 2 : si le nombre de valeur de la cellule dans pla plage pl est supérieur à un
If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
Set r = pl.Find(cel.Value, , xlValues, xlWhole) 'définit la variable r
If Not r Is Nothing Then
pa = r.Address 'si il existe au moins une occurrence de r dans pl définit la variable pa
r.Font.ColorIndex = 5 'met l'encre bleue dans l'occurrence trouvée
End If
Do 'exécute
Set r = pl.FindNext(r) 'redéfinit la variable r (prochaine occurrence)
r.Font.ColorIndex = 5 'met l'encre bleue dans la nouvelle occurrence
s = s + CDbl(r.Offset(0, 1).Value) 'redéfinit la variable s
Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
Else 'sinon (condition 2)
s = CDbl(cel.Offset(0, 1).Value) 'définit la variable s
End If 'fin de la condition 2
Set dest = Sheets("Feuil1").Range("D65536").End(xlUp).Offset(1, 0) 'définit la variable dest
dest.Value = cel.Value 'récupère le numéro OF
dest.Offset(0, 1).Value = s 'récupère la somme
End If 'fin de la condition1
Next cel 'prochaine cellule de la plage
pl.Font.ColorIndex = 1 'remet la couleur d'encre noire dans la plage pl
End Sub
