XL 2016 Si occurrences, concaténer en VBA

fabt33

XLDnaute Nouveau
Bonjour,

Je suis actuellement sur un petit projet, mais je n’arrive pas à réaliser cette partie :

J’ai une liste de produit dans laquelle il peut y avoir des occurrences.

Si l’occurrence en colonne A se confirme, je souhaiterai concaténer les informations.
j’aimerai que cette dynamisation s’effectue sur ma liste directement avec certains critères.

Ci-dessous un exemple qui devrait être explicite :

exemple.png


Ci-joint un fichier en exemple
( les colonnes sont identiques à mon projet )

Merci d’avance pour vos retours.

Cdt,

Fabien
 

Pièces jointes

  • exemple_liste.xlsx
    13.4 KB · Affichages: 6
Solution
Bonsoir,

Avant tout enregistre ton fichier au format xlsm, format acceptant les macros.
Ensuite, dans module standard copie et colle le code ci-dessous.
Alt+F11 affiche l’éditeur de code, ensuite menu Insertion clique sur Module
Puis exécute ce code
VB:
Option Explicit

Sub reduire_lignes()
    Dim i As Integer, dl As Integer

    With Sheets("exemple")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = dl To 1 Step -1
            If .Cells(i, 1).Value = .Cells(i, 1).Offset(1, 0).Value Then
                .Cells(i, 6).Value = .Cells(i, 6).Value + .Cells(i, 6).Offset(1, 0).Value
                .Cells(i, 7).Value = .Cells(i, 7).Value & "/" & .Cells(i, 7).Offset(1, 0).Value
                .Cells(i, 1).Offset(1...

cathodique

XLDnaute Barbatruc
Bonsoir,

Avant tout enregistre ton fichier au format xlsm, format acceptant les macros.
Ensuite, dans module standard copie et colle le code ci-dessous.
Alt+F11 affiche l’éditeur de code, ensuite menu Insertion clique sur Module
Puis exécute ce code
VB:
Option Explicit

Sub reduire_lignes()
    Dim i As Integer, dl As Integer

    With Sheets("exemple")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = dl To 1 Step -1
            If .Cells(i, 1).Value = .Cells(i, 1).Offset(1, 0).Value Then
                .Cells(i, 6).Value = .Cells(i, 6).Value + .Cells(i, 6).Offset(1, 0).Value
                .Cells(i, 7).Value = .Cells(i, 7).Value & "/" & .Cells(i, 7).Offset(1, 0).Value
                .Cells(i, 1).Offset(1, 0).EntireRow.Delete
            End If
        Next i
    End With
End Sub
Bonne soirée.
 

Discussions similaires

Réponses
5
Affichages
733

Statistiques des forums

Discussions
315 095
Messages
2 116 166
Membres
112 675
dernier inscrit
Tazra_IMOU