Macro addition ligne

Le 04/07/2018 à 16:15

Bonjour la communauté,

J'ai des difficultés à traduire ligne à ligne le code VBA implémenté dans le fichier "prépa", le principe de la macro est de sélectionner le fichier "données" et la macro va additionner les données Qté des lignes. Vous pouvez tester ! J'ai réussi seulement à traduire une toute petite partie du code. Quelqu'un aurait l'amabilité de me traduire tout le reste des lignes ? je m'autoforme en VBA. merci

7donnees.xlsx (7.94 Ko)
13prepa.xlsm (23.24 Ko)
Le 04/07/2018 à 17:21

bonjour

pas de VBA

si un jour tu penses en avoir besoin c'est que tu ne connais pas Excel et ses immenses possibilités

apprends Python ou C++ si tu veux programmer, pas VBA vénérable langage qui a fait son temps

ah, oui, ta solution par Excel :

5donnees.xlsx (11.82 Ko)
Le 04/07/2018 à 18:02

Bonsoir,

ce code qui le code modifié à la-va-vite, d'un code prévu pour la fusion de 2 fichiers avec des commentaires.

Sub aargh()
    k = 1 'compteur de ligne sur wst
    Set wst = ThisWorkbook.Sheets(1)    'Déclaration wst est la feuille présente
    wst.Cells.Clear
    With Application.FileDialog(msoFileDialogFilePicker)    'Sortir la fenêtre de dialogue
        .AllowMultiSelect = False
        .Title = "sélection des fichiers à ouvrir"
        .Filters.Clear
        .Filters.Add "Excel files", "*.XLS*"    'Sélectionne seulement les fichiers Excel
        If .Show = True Then
                Set wb1 = Workbooks.Open(.SelectedItems(1))
                Set ws1 = wb1.Sheets(1)
                dl1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row    'Nombre de ligne de la feuille ws1
        Else
            MsgBox "pas de fichier sélectionné"    'Sinon message d'erreur
            Exit Sub
        End If
    End With
    With ws1    'tri de la feuille sur colonne A,B,C,D
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A2:A" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("B2:B" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("C2:C" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("D2:D" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:E" & dl1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    i1 = 2
    k3 = "" 'clé en cours de wst
    k1 = joinC(ws1.Cells(i1, 1).Resize(, 4), "|") ' concaténation des cellules A,B,C et D de la ligne i1 de ws1
    Do
        If k1 <> k3 Then 'clé de ligne en cours ws1 différente de la clé en cours wst
            k = k + 1 'on incrémente le compteur de ligne
            ws1.Cells(i1, 1).Resize(, 5).Copy wst.Cells(k, 1) 'on copie la ligne de ws1 vers wst
            k3 = k1 'la clé en cours sur wst est la clé de la ligne en cours sur ws1
        Else
            wst.Cells(k, 5).Value = wst.Cells(k, 5).Value + ws1.Cells(i1, 5).Value    'Sinon si rien n'est différent entre les cellules des différents feuilles de la colonne 1-4 faire la somme
        End If
        If i1 < dl1 Then    'si numéro de ligne est inférieur au nombre de lignes de la feuille ws1
            i1 = i1 + 1
            k1 = joinC(ws1.Cells(i1, 1).Resize(, 4), "|") ' concaténation des cellules A,B,C et D de la ligne i1 de ws1
        Else
            k1 = Chr(255) 'indicateur de fin
        End If
    Loop Until k1 = Chr(255)
    wb1.Close False 'fermer fichier
    With wst.Cells(1, 1).Resize(k, 5) 'mise en forme du tableau
        .Interior.Color = xlNone
        .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
        .Font.Bold = False
    End With
    With wst
        .Cells(1, 1).Value = "Magasin"
        .Cells(1, 2).Value = "Article"
        .Cells(1, 3).Value = "Année prév"
        .Cells(1, 4).Value = "Mois prév"
        .Cells(1, 5).Value = "Q"
    End With
End Sub
Function joinC(r, st)
'concaténation des données du tableau r avec st comme concaténateur
    For Each c In r 'on prend c chaque élément du tableau r
        s = s & c.Value & st 'on l'ajoute à la chaine s ainsi que le caractère de concaténation
    Next
    s = Left(s, Len(s) - 1) 'on enlève le dernier caractère de concaténation
    joinC = s 'on retourne le résultat de la fonction
End Function
Le 05/07/2018 à 17:57

Bonjour h2so4, j'espère que vous allez bien,

Function joinC(r, st)
'concaténation des données du tableau r avec st comme concaténateur
    For Each c In r 'on prend c chaque élément du tableau r
        s = s & c.Value & st 'on l'ajoute à la chaine s ainsi que le caractère de concaténation
    Next
    s = Left(s, Len(s) - 1) 'on enlève le dernier caractère de concaténation
    joinC = s 'on retourne le résultat de la fonction
End Function

Est-ce que vous pouvez m'expliquer à quoi sert ce code ? je le comprend pas du tout, qu'est-ce que "r" et qu'est-ce que "s" et "c" ?

Le 05/07/2018 à 18:49

Bonsoir,

comme le code adapté à la va-vite pose des problèmes de compréhension. je l'ai réécrit de manière plus simple et plus compréhensible (enfin j'espère).

une bonne astuce pour comprendre ce que fait un code et chaque instruction. exécuter le code en mode pas à pas (F8) et examiner le contenu des variables ou des cellules impliquées dans chaque instruction.

Sub aargh()
    k = 1    'compteur de ligne sur wst
    Set wst = ThisWorkbook.Sheets(1)    'Déclaration wst est la feuille présente
    wst.Cells.Clear
    With Application.FileDialog(msoFileDialogFilePicker)    'Sortir la fenêtre de dialogue
        .AllowMultiSelect = False
        .Title = "sélection des fichiers à ouvrir"
        .Filters.Clear
        .Filters.Add "Excel files", "*.XLS*"    'Sélectionne seulement les fichiers Excel
        If .Show = True Then
            Set wb1 = Workbooks.Open(.SelectedItems(1))
            Set ws1 = wb1.Sheets(1)
            dl1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row    'Nombre de ligne de la feuille ws1
        Else
            MsgBox "pas de fichier sélectionné"    'Sinon message d'erreur
            Exit Sub
        End If
    End With
    With ws1    'tri de la feuille sur colonne A,B,C,D
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A2:A" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("B2:B" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("C2:C" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("D2:D" & dl1) _
                                  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:E" & dl1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    For i1 = 2 To dl 'on parcourt chaque ligne de ws1
        With ws1
            If .Cells(i1, 1) = .Cells(i1 - 1, 1) And .Cells(i1, 2) = .Cells(i1 - 1, 2) And .Cells(i1, 3) = .Cells(i1 - 1, 3) And .Cells(i1, 4) = .Cells(i1 - 1, 4) Then
             'colonnes A,B,C,D de la ligne en cours égales à celles de la ligne précédente
                wst.Cells(k, 5).Value = wst.Cells(k, 5).Value + .Cells(i1, 5).Value 'on additionne
            Else 'pas égales
                k = k + 1    'on incrémente le compteur de ligne
                .Cells(i1, 1).Resize(, 5).Copy wst.Cells(k, 1)    'on copie la ligne de ws1 vers wst
            End If
        End With
    Next i1

    wb1.Close False    'fermer fichier
    With wst.Cells(1, 1).Resize(k, 5)    'mise en forme du tableau
        .Interior.Color = xlNone
        .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
        .Font.Bold = False
    End With
    With wst
        .Cells(1, 1).Value = "Magasin"
        .Cells(1, 2).Value = "Article"
        .Cells(1, 3).Value = "Année prév"
        .Cells(1, 4).Value = "Mois prév"
        .Cells(1, 5).Value = "Q"
    End With
End Sub

pour ce qui est de la fonction joinC. je t'invite à lire la documentation de la l'instruction VBA join. c'est exactement la même chose, mais j'ai dû en faire une fonction personnalisée pour pouvoir concaténer des plages de cellules.

Rechercher des sujets similaires à "macro addition ligne"