Discussion :

[ffasan]

Bonsoir,

J'ai 2 questions. Dans une macro Excel,

1/ pour des records en doublon (colonne A), comment faire pour n'avoir qu'un seul record dans la colonne A ET sommer des montants des autres colonnes (colonnes B ...) pour cet enregistrement?

2/ dans un tableau, comment , pour une valeur donnée, vérifier si les autres enregistrements n'ont pas une valeur indésirable (dans une même colonne)?

Ci-joint un fichier Excel explicitant avec un exemple pour chaque question et le résultat attendu.

Merci par avance pour votre aide !

[mercatog]

Une code commenté, si ça peut aider pour la question 1 (même si déconseillé de donner un code prêt à l'emploi)

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
Option Explicit
 
Sub Test()
Dim LastLig As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("Feuil2")
    'On efface la feuille Feuil2
    .UsedRange.Clear
    'On copie les données brutes vers la feuille Feuil2
    Worksheets("Feuil1").UsedRange.Copy .Range("A1")
    'Dernière ligne remplie de la colonne A
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    'On parcourt les cellules de la dernière en remontant
    For i = LastLig To 5 Step -1
        'Si la valeur de la cellule Ai est présente plus qu'une fois (utilisation sous vba de NB.SI)
        If Application.CountIf(.Range("A4:A" & i), .Range("A" & i)) > 1 Then
            'On cherche l'autre valeur de la cellule Ai dans A4:Ai-1
            Set c = .Range("A4:A" & i - 1).Find(.Range("A" & i), LookIn:=xlValues, lookat:=xlWhole)
            'on principe on doit la trouver, ce test est inutile
            If Not c Is Nothing Then
                'On copie la plage Bi:Mi
                .Range("B" & i & ":M" & i).Copy
                'et on le colle (collage spécial opération Addition) dans la colonne B de la cellule c trouvée
                c.Offset(0, 1).PasteSpecial Operation:=xlAdd
                'on supprime la ligne i
                .Rows(i).Delete
                Set c = Nothing
            End If
        End If
    Next i
End With
End Sub