XL 2016 Valeurs de Zones discontinues

fanch55

XLDnaute Barbatruc
Bonjour à tous,
Il doit surement y avoir une solution mais je n'ai pas trouvé ou mal cherché ... 🤔

Je bloque pour récupérer facilement les valeurs d'un range de cellules discontinues .

Exemple, je sélectionne un range ainsi :
Range("A1:A8,J9,C8:C9,etc...")​
ou​
Union([Table1[Colonne1]],[Table2[Colonne6]],etc..)​
Via Excel, aucun problème, je sélectionne, je copie et je colle les valeurs dans d'autres cellules correctement .👍

Par contre, via le VBA, je suis incapable de récupérer facilement les valeurs des cellules sélectionnées,
le .value ou .value2 ne me renvoie les valeurs que de la première zone.👎
Sinon, il faut décliner les .Areas obtenus .

C'est pareil en passant par le selection.
Y a-t-il une autre solution (courte) pour récupérer ces valeurs dans un tableau ?
 
Solution
Bonsoir.
Plus court non, mais beaucoup plus rapide oui ! :
VB:
Private Sub Cbx_DropButtonClick()
   Dim Target As Range, Zone As Range, TCible(), LC As Long, TSource(), LS As Long
   Set Target = Union([Tableau1[Nom]], [Tableau2[Nom]], [Tableau3[Nom]], [Tableau4[Nom]])
   For Each Zone In Target.Areas: LC = LC + Zone.Rows.Count: Next Zone
   ReDim TCible(1 To LC, 1 To 1): LC = 0
   For Each Zone In Target.Areas
      TSource = Zone.Value
      For LS = 1 To UBound(TSource, 1)
         LC = LC + 1: TCible(LC, 1) = TSource(LS, 1)
         Next LS, Zone
    Cbx.List = TCible
    End Sub

fanch55

XLDnaute Barbatruc
Bon, on va faire du concret avec le classeur ci-joint .
Je cherche à mettre toutes les boissons des quatre tables de la feuille Boisson (expurgée) dans un Combobox .

En usage habituel d'un combobox mono colonne, on peut le remplir en faisant juste:
Combobox.list = range("A1:A10").value pour une zone fixe​
ou​
Combobox.List = [Tableau1[Nom]].Value pour une colonne de table structurée​
ou​
Combobox.list = [Nom].value pour une zone nommée​

J'ai été obligé de faire le code ci-dessous pour le classeur joint car mes valeurs ne sont pas contiguës :
VB:
Private Sub Cbx_DropButtonClick()
Dim Target  As Range
Dim V       As Variant

    Set Target = Union([Tableau1[Nom]], [Tableau2[Nom]], [Tableau3[Nom]], [Tableau4[Nom]])
        V = vbNullString
            For Each elem In Target.Areas
                V = IIf(V = "", "", V & vbTab) & Join(Application.Transpose(elem.Value), vbTab)
            Next
        V = Split(V, vbTab)
    Set Target = Nothing
    Cbx.List = V
End Sub

Si quelqu'un a une méthode ou un code plus court, je suis preneur . 🤗
 

Pièces jointes

  • Zonesdiscontinues.xlsm
    29.9 KB · Affichages: 18
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonsoir.
Plus court non, mais beaucoup plus rapide oui ! :
VB:
Private Sub Cbx_DropButtonClick()
   Dim Target As Range, Zone As Range, TCible(), LC As Long, TSource(), LS As Long
   Set Target = Union([Tableau1[Nom]], [Tableau2[Nom]], [Tableau3[Nom]], [Tableau4[Nom]])
   For Each Zone In Target.Areas: LC = LC + Zone.Rows.Count: Next Zone
   ReDim TCible(1 To LC, 1 To 1): LC = 0
   For Each Zone In Target.Areas
      TSource = Zone.Value
      For LS = 1 To UBound(TSource, 1)
         LC = LC + 1: TCible(LC, 1) = TSource(LS, 1)
         Next LS, Zone
    Cbx.List = TCible
    End Sub
 

fanch55

XLDnaute Barbatruc
Bonjour à tous en ce dernier dimanche de confinement,
J'ai testé les 2 versions qui fonctionnent correctement .
Les 2 le font en moins d'1 seconde.
Quand à savoir qui est la plus rapide, je reste dubitatif 🤔
Méthode FanchMéthode Dranreb
00,75​
00,73
00,55​
00,42
00,22​
00,02
00,88​
00,73
00,55​
00,40
00,22​
00,09
00,96​
00,84
00,68​
00,48
00,39​
00,77
00,50​
00,51
00,28​
00,98
00,26​
00,64
00,02​
00,64
00,14​
00,48
Moyenne 00.46​
00.55 Moyenne
Merci à @laurent950 pour sa remarque qui permet de raccourcir le code de @Dranreb ,
Code que j'ai également un peu "compressé" .
VB:
Private Sub Cbx_DropButtonClick() ' DranReb
Dim Target As Range, Zone As Range, TCible(), LC As Long, TSource(), LS As Long
   Set Target = Union([Tableau1[Nom]], [Tableau2[Nom]], [Tableau3[Nom]], [Tableau4[Nom]])
 
' Ce qui change -----------------------------------------------------------------------------------
   ReDim TCible(Target.Count)
   For Each Zone In Target.Areas
      TSource = Zone.Value
      For LS = 1 To UBound(TSource, 1)
         LC = LC + 1: TCible(LC) = TSource(LS, 1)
    Next LS, Zone
  ' ----------------------------------------------------------------------------------------------------

    Cbx.List = TCible
End Sub
VB:
Private Sub Cbx_DropButtonClick() 'Fanch55
Dim Target  As Range, V  As Variant, Elem As Range
    Set Target = Union([Tableau1[Nom]], [Tableau2[Nom]], [Tableau3[Nom]], [Tableau4[Nom]])
 
' Ce qui change -----------------------------------------------------------------------------------
        V = vbNullString
            For Each Elem In Target.Areas
                If V = "" Then V = "" Else V = V & vbTab
                V = V & Join(Application.Transpose(Elem.Value), vbTab)
            Next
        V = Split(V, vbTab)
  ' ----------------------------------------------------------------------------------------------------

    Set Target = Nothing
    Cbx.List = V
End Sub

Si on compare les 2 parties , ce qui change est grosso-modo la même chose ... 🤗
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

[Précisions]
Je suis confiné
Je n'ai donc pas pu donné de bakchich à patrick pour promouvoir mon code VBA.
Surtout qu'il n'y a pas cette case sur mon attestation dérogatoire de déplacement
[X] Déplacement pour corruption d'XLDien administratif principal de 1erè classe

OK je sors
;)
 

patricktoulon

XLDnaute Barbatruc
re
je n'ai pas besoins de bakchich quand c'est net c'est net c'est tout
laurent tu pouvais laisser tes propositions
tu es simplement trop enthousiaste avec les bricotruc (evaluate et compagnie) qui sont inutiles dans ce contexte
et n'ai pas peur de mettre des debug.print dans tes codes et regarde le résultat dans la fenêtre d’exécution
tu les enlèves quand c'est au point
Staple1600 merci pour le virement bancaire je le dirais a personne tu peux me faire confiance
ps:
@fanch55 je viens de re tester pour être sur et ca match la combo contient bien les valeurs de tout les tableaux
;)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 540
Messages
2 080 523
Membres
101 234
dernier inscrit
Layani89