XL 2016 Si occurrences, concaténer en VBA

fabt33 · 12 Novembre 2021

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 :

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

Merci d’avance pour vos retours.

Cdt,

Fabien

cathodique · 12 Novembre 2021

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 · 12 Novembre 2021

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.

fabt33 · 13 Novembre 2021

Bonjour Cath,

Un énorme merci pour ta proposition qui est parfaite !

Cdt,
Fab

XL 2016 Si occurrences, concaténer en VBA

fabt33

XLDnaute Nouveau

Pièces jointes

cathodique

cathodique

XLDnaute Barbatruc

fabt33

XLDnaute Nouveau

Discussions similaires