Microsoft 365 Macro Excel pour effectuer des opérations sur les lignes et cellules adjacentes

Hecatonchire à dit:

A toi de choisir :
> Cette macro exporte les données dans une nouvelle feuille : Pas de mise à jour du résultat si l'on modifie les données de départ
> Cette macro génère la formule "=LET(m1r..." dans une nouvelle feuille : Mise à jour du résultat si l'on modifie les données de départ

Concernant le tableau de départ :
> On considère qu'il commence toujours en A1
> Ou que l'utilisateur doit cliquer dedans (peut ainsi être positionné ailleurs que A1)

Cliquez pour agrandir...

Hecatonchire à dit:

A toi de choisir :
> Cette macro exporte les données dans une nouvelle feuille : Pas de mise à jour du résultat si l'on modifie les données de départ
> Cette macro génère la formule "=LET(m1r..." dans une nouvelle feuille : Mise à jour du résultat si l'on modifie les données de départ

Concernant le tableau de départ :
> On considère qu'il commence toujours en A1
> Ou que l'utilisateur doit cliquer dedans (peut ainsi être positionné ailleurs que A1)

Cliquez pour agrandir...

Hecatonchire à dit:

Je n'ai pas voulu réinventer quelque chose de nouveau donc je suis parti de la formule Let comme base.
A toi de compléter la code (ajout d'entête, mise en forme, renommer la feuille...)

VB:

Sub Export()
    Dim objFeuilleActive        As Worksheet
    Dim lgFinTab                As Long     ' N° de la dernière ligne
    Dim strPlageA               As String
    Dim strPlageB               As String
    Dim strPlageC               As String
    Dim rgPlage                 As Range    ' Plage résultat
    Dim tabPlage()                          ' Tableau pour écraser la formule
   
    Application.ScreenUpdating = False
    lgFinTab = [A1].End(xlDown).Row
    strPlageA = "'" & ActiveSheet.Name & "'!A2:A" & lgFinTab
    strPlageB = "'" & ActiveSheet.Name & "'!B2:B" & lgFinTab
    strPlageC = "'" & ActiveSheet.Name & "'!C2:C" & lgFinTab
   
    Set objNouvelleFeuille = ActiveWorkbook.Worksheets.Add
    objNouvelleFeuille.Range("A2").Formula2Local = "=LET(m1r;UNIQUE(" & strPlageA & ");" & _
                "m2r;MAP(m1r;LAMBDA(v;JOINDRE.TEXTE("" > "";VRAI;FILTRE(" & strPlageB & ";" & strPlageA & "=v))));" & _
                "m3r;MAP(m1r;LAMBDA(v;SOMME(FILTRE(" & strPlageC & ";" & strPlageA & "=v))));" & _
                "ASSEMB.H(m1r;m2r;m3r))"
    ' On écrase la formule
    Set rgPlage = objNouvelleFeuille.[A2].CurrentRegion
    tabPlage = rgPlage.Value
    rgPlage.Value = tabPlage
    ' Nettoyage
    objNouvelleFeuille.Columns("A:C").EntireColumn.AutoFit
    Set rgPlage = Nothing
    Set objNouvelleFeuille = Nothing
    Application.ScreenUpdating = True
End Sub

Cliquez pour agrandir...