XL 2016 VBA : Extraire données tableau sur une autre colonne

R

Rouge

XLDnaute Impliqué

• 12 Octobre 2020

• #2

Bonjour,

En B4, formule matricielle à valider avec CTRL + SHIFT + ENTREE et à tirer vers le bas
=SIERREUR(INDEX($C$4:$C$13;PETITE.VALEUR(SI($D$4:$D$13="ACTIVE";LIGNE(INDIRECT("1:"&LIGNES($C$4:$C$13))));LIGNES($1:1));1);"")

Cdlt

 

Vote positif 0 Vote négatif

J

JHA

XLDnaute Barbatruc

• 12 Octobre 2020

• #3

Bonjour à tous,

La formule proposée par Rouge 🙂 ne gère pas les doublons.
Ci-joint une solution simple et rapide par power query

JHA

 

Pièces jointes

• Tuto 5.xlsx

  22.6 KB · Affichages: 4

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 12 Octobre 2020

• #4

Bonjour JHA,
Effectivement je n'avais pas fait le test avec des doublons, je propose la correction, histoire de ne pas laisser une erreur, bien que POWER QUERY soit plus adapté.
la formule corrigée (toujours à valider avec CTRL + SHIFT + ENTREE):
=SIERREUR(SI(NB.SI($B3:$B$3;INDEX($C$3:$C$13;PETITE.VALEUR(SI($D$3:$D$13="ACTIVE";LIGNE(INDIRECT("1:"&LIGNES($C$3:$C$13))));LIGNES($1:1))😉)<>0;"";INDEX($C$3:$C$13;PETITE.VALEUR(SI($D$3:$D$13="ACTIVE";LIGNE(INDIRECT("1:"&LIGNES($C$3:$C$13))));LIGNES($1:1))😉);"")

Cdlt

 

Vote positif 0 Vote négatif

Yücel

XLDnaute Junior

• 12 Octobre 2020

• #5

Bonjour et merci à Rouge et JHA,

Ce n'est pas exactement ce que je voulais, je sais que c'est compliqué ce que je veux mais je retente.

Je m'explique, dans le tableau j'ai le nom des banques dans la colonne C avec des doublons (normale car plusieurs clients).
Je voulais que dans la colonne B (que je masquerai par la suite), le nom des banques soit repris uniquement si le statut est " active" (sans formule plutôt avec VBA) et sans les doublons.

Exemple ici le résultat doit être :

B4 : Caisse d'épargne
B5 : HSBC
B6 : BNP
et ça s’arrête là.


En vous remerciant par avance.
Très bonne journée à vous.

 

Pièces jointes

• Tuto 5.xlsx

  13.9 KB · Affichages: 3

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 12 Octobre 2020

• #6

Alors copiez ceci dans le module de la feuille (réagit à chaque intervention dans la colonne "STATUT")

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DerLig As Long, Lig As Long
    DerLig = Range("C" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("D4:D" & DerLig)) Is Nothing Then
        Application.ScreenUpdating = False
        Lig = 4
        For i = 4 To DerLig
            If Cells(i, "D") = "Active" Then
                Bq = Cells(i, "C")
                If Application.WorksheetFunction.CountIf(Range("B4:B" & DerLig), Bq) = 0 Then
                    Cells(Lig, "B") = Bq
                    Lig = Lig + 1
                End If
            End If
        Next
    End If
End Sub

Cdlt

 

Vote positif 0 Vote négatif

Yücel

XLDnaute Junior

• 12 Octobre 2020

• #7

Bonjour Rouge,

Je viens de coller ce code sur la feuil1 du visual basic mais rien ne se passe en colonne B.

Merci à vous.

 

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 12 Octobre 2020

• #8

L'avez-vous bien coller dans le module de la feuille et non dans un module standard?

Le fichier en pièce jointe

 

Pièces jointes

• Yücel_VBA-Extraire données tableau sur une autre colonne.xlsm

  19.8 KB · Affichages: 6

Vote positif 0 Vote négatif

Yücel

XLDnaute Junior

• 12 Octobre 2020

• #9

Merci Rouge,

C'est presque ça !! merci 😀

Problème :
Lorsque je supprime des banques en statut "active" ça me les retire pas en instantané dans la colonne B.

 

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 12 Octobre 2020

• #10

Voici la petite modification

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DerLig As Long, Lig As Long
    Dim CellActive As String
    CellActive = Target.Address
    DerLig = Range("C" & Rows.Count).End(xlUp).Row
    Application.EnableEvents = False
    Range("B4:B" & DerLig).ClearContents
    If Not Intersect(Range(CellActive), Range("D4:D" & DerLig)) Is Nothing Then
        Application.ScreenUpdating = False
        Lig = 4
        For i = 4 To DerLig
            If Cells(i, "D") = "Active" Then
                Bq = Cells(i, "C")
                If Application.WorksheetFunction.CountIf(Range("B4:B" & DerLig), Bq) = 0 Then
                    Cells(Lig, "B") = Bq
                    Lig = Lig + 1
                End If
            End If
        Next
    End If
    Application.EnableEvents = True
End Sub

Le fichier

 

Pièces jointes

• Yücel_VBA-Extraire données tableau sur une autre colonne.xlsm

  20.3 KB · Affichages: 5

Vote positif 0 Vote négatif

Solution

Yücel

XLDnaute Junior

• 12 Octobre 2020

• #11

Mille merci Rouge !! vous êtes trop forte 😀

Très bonne journée à vous !

 

Vote positif 0 Vote négatif