copier/coller sous conditions

[Demanda]

Bonjour à tous,

J'ai un fichier excel contenant 2 colonnes : l'une contenant un numéro d'OF (colonne A) et l'autre un temps (colonne B)
Je voudrais copier/coller ces deux colonnes sur les colonnes D:E par exemple, mais pas tel quel.
En fait, je souhaiterai n'avoir que des numéros d'OF uniques. Actuellement, j'ai dans la colonne A plusieurs numéros d'OF. Et dans le même temps, je voudrais sommer les temps de ces OF.
Exemple : OF 10 temps 2 ; OF 10 temps 3 ; OF 11 temps 4.
Ca donnerait après copier/coller : OF 10 temps 5; OF 11 temps 4

Ci-joint, mon début de programme

Merci d'avance pour vos réponses

Sub somme()
Dim plage, cell As Range
Dim i, j As Integer
i = 2
j = i + 1
Set plage = Range("A" & Sheets(1).[A65536].End(xlUp).Row + 1)
For Each Cells In plage
If Cells(j, 1).Value = "" Then
Else

If Cells(i, 1) <> Cells(j, 1) Then
Cells(i, 1).Copy Range("D" & Sheets(1).[D65536].End(xlUp).Row + 1)
Cells(i, 1).Copy Range("E" & Sheets(1).[E65536].End(xlUp).Row + 1)

Else


End Sub

 

[Robert]

Re : copier/coller sous conditions

Bonjour Demanda, bonjour le forum,

Je te propose la macro ci-dessous qui utilise une couleur d'encre bleue temporaire dans la colonne A :

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 toutes 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 la 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
            Do 'exécute
                Set r = pl.FindNext(r) 'redéfinit la variable r (prochaine occurrence)
                s = s + CDbl(r.Offset(0, 1).Value) 'redéfinit la variable s
                r.Font.ColorIndex = 5 'met l'encre bleue dans la nouvelle occurrence
            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

 

[Demanda]

Re : copier/coller sous conditions

Merci beaucoup pour ta réponse Robert. Cependant, quand un OF est en doublon, la somme des valeurs temporelles est mauvaise. Je vais essayer de regarder ça.

 

[Robert]

Re : copier/coller sous conditions

Bonjour Demanda, bonjour le forum,

Oui j'avais remarqué ça et j'ai modifié les codes. J'ai rajouté une formule dans la colonne G pour vérifier et ça a l'air de coller...

 

[Demanda]

Re : copier/coller sous conditions

Ca marche nickel. Merci beaucoup à toi!!