Microsoft 365 Extraction de résultats selon une condition

[boza]

Bonjour à toutes et à tous,

J'ai encore besoin d'un coup de main pour mon projet.
Dans un premier onglet j'ai un code postal en colonne A.
Dans un 2eme onglet j'ai ce code postal sur une ligne et les colonnes sont des numéros de magasins qui développent du CA dans ce code postal.
Je souhaiterais connaitre les numéros des magasins qui font du CA dans la colonne B du premier onglet

Je vous joint un fichier pour une meilleure compréhension.

Merci de votre aide !

 

[JHA]

Bonjour à tous,

A essayer ces 2 solutions

JHA

 

[soan]

Bonjour boza, JHA,

ton fichier en retour.

formule en B2 : =SI(A2="";"";Magasins(A2))

---

voici la fonction personnalisée Magasins() :

Function Magasins(CP$) As String
  Application.Volatile
  Dim cel As Range, mg$, ca#, tot#, n%, lig&, dcol%, chn$, s$, i%
  With Worksheets("CA")
    Set cel = .Columns(1).Find(CP, , -4163, 1, 1)
    If cel Is Nothing Then Exit Function
    dcol = .Cells(1, Columns.Count).End(1).Column
    If dcol < 3 Then Exit Function
    lig = cel.Row
    For i = 2 To dcol - 1
      mg = .Cells(1, i)
      If mg <> "" Then
        With .Cells(lig, i)
          ca = Round(.Value, 2)
          If ca > 0 And mg <> "(vide)" Then
            s = Format(ca, "#,##0.00")
            chn = chn & mg & " :" & Space$(18 - Len(s)) & s & vbLf
            tot = tot + ca: n = n + 1
          End If
        End With
      End If
    Next i
  End With
  If n > 0 Then chn = chn & vbLf & n & _
    " magasins :    " & Format(tot, "#,##0.00")
  Magasins = chn
End Function

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

 

[soan]

Bonjour boza,

Lis d'abord mon post #3 précédent.

cette 2ème version de mon fichier, c'est au cas où vraiment
tu préférerais les montants sans les centimes :

remarque n° 1 : dans le ficher de mon post précédent, comme dans celui-ci, si tu ajoutes de nouvelles lignes (avec d'autres codes postaux), elles seront prises en compte ; si tu ajoutes d'autres colonnes (avec d'autres magasins), elles seront aussi prises en compte ; mais si l'en-tête de colonne est vide, ou s'il contient la valeur "(vide)", alors la colonne sera naturellement ignorée.

remarque n° 2 : tu verras que le résultat en B2 se met à jour si tu modifies A2 OU si tu modifies une des données des lignes 1 et 2 de la feuille "CA". (la modification peut être un changement de valeur, ou la suppression d'une valeur) ; ceci est valable pour les 2 fichiers.
​

---

je vais me permettre une petite question très indiscrète : si tu as un Chiffre d'Affaires de 202 661 € pour seulement le 5ème arrondissement de Paris (même en 4 magasins), alors tu es super extra riche ? bon, d'accord, peut-être pas autant que Bill Gates, ni autant que Midas ou Crésus, mais c'est quand même déjà pas mal ! on partage fifty-fifty ? ​

---

voici la nouvelle fonction personnalisée Magasins() :

Function Magasins(CP$) As String
  Application.Volatile
  Dim cel As Range, mg$, ca#, tot#, n%, lig&, dcol%, chn$, s$, i%
  With Worksheets("CA")
    Set cel = .Columns(1).Find(CP, , -4163, 1, 1)
    If cel Is Nothing Then Exit Function
    dcol = .Cells(1, Columns.Count).End(1).Column
    If dcol < 3 Then Exit Function
    lig = cel.Row
    For i = 2 To dcol - 1
      mg = .Cells(1, i)
      If mg <> "" Then
        With .Cells(lig, i)
          ca = Round(.Value, 0)
          If ca > 0 And mg <> "(vide)" Then
            s = Format(ca, "#,##0")
            chn = chn & mg & " :" & Space$(18 - Len(s)) & s & vbLf
            tot = tot + ca: n = n + 1
          End If
        End With
      End If
    Next i
  End With
  If n > 0 Then chn = chn & vbLf & n & _
    " magasins :    " & Format(tot, "#,##0")
  Magasins = chn
End Function

pour le « SAV », idem : si tu as besoin d'une adaptation,
n'hésite pas à demander.

soan

 

[job75]

Bonjour boza, JHA, soan,

Cette macro évènementielle permet de créer des listes de validation en colonne B de la feuille "Données" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lig As Variant, P As Range, Q As Range, R As Range
[B:B].Validation.Delete
With Sheets("Liste")
    .[1:3].Delete 'RAZ
    If Intersect(ActiveCell, [B:B]) Is Nothing Then Exit Sub
    On Error Resume Next
    With Sheets("CA")
        lig = Application.Match(ActiveCell(1, 0), .Columns(1), 0)
        Set P = .Rows(1).SpecialCells(xlCellTypeConstants, 1)
        Set Q = .Rows(lig).SpecialCells(xlCellTypeConstants, 1)
    End With
    Set R = Union(Intersect(P, Q.EntireColumn), Intersect(Q, P.EntireColumn))
    If R Is Nothing Then Exit Sub
    R.Copy .[A1]
    With .[A1].CurrentRegion.Rows(3)
        .FormulaR1C1 = "=R[-2]C&"" - ""&R[-1]C"
        .Name = "Liste" 'plage nommée
    End With
    ActiveCell.Validation.Add xlValidateList, Formula1:="=Liste" 'crée la liste
End With
End Sub

A+

 

[soan]

Bonjour boza, le fil,

* tu as posté ta demande le 16 juin, en joignant un fichier, et en écrivant : « Merci de votre aide ! »

* JHA t'a proposé une solution le 16 juin.

* je t'ai proposé une solution le 16 juin, et même une autre le 17 juin.

* job75 t'a proposé une solution le 17 juin.

* tu es revenu sur le site XLD mardi 29 juin à 18:28, mais sans donner ici de réponse ! aucun avis, sur aucune des 4 solutions proposées !

ça aurait été sympa de ta part d'écrire un petit post pour indiquer si une ou plusieurs solutions proposées ont résolu ton exo (comme tu l'espérais) ; sinon, tu aurais pu indiquer ce qui ne va pas, et donner éventuellement un petit complément d'information.

j'espère que ta non-réponse n'est pas due au coronavirus ! tu as peut-être oublié de mettre un masque au moment de faire tes courses ? ​

soan