Definir une Matrice (Range) en fonction du contenu de la 1ère colonne

gescc

XLDnaute Nouveau
Bonjour,

J'aurais voulu savoir si on pouvait dans VBA, definir une matrice en fonction du contenu de la 1ère colonne.

Ex :

Val Don1 Don2
1 45 36
1 65 24
1 45 41
1 12 18
2 14 54
2 45 47
2 11 13
3 16 17
3 11 12

si je choisi 2, je veux créer une variable range avec les valeurs en rouge.

Je ne suis pas sûr d'avoir été 100% clair !!!!

Mci.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Definir une Matrice (Range) en fonction du contenu de la 1ère colonne

Bonjour.
Worksheetfunction.Match peut vous donner la ligne de départ dans l'ensemble, Find peut même vous donner la cellule de départ et Worksheetfunction.Countif peut vous donner le nombre de lignes (sous réserve de non répétition de la valeur dans d'autres groupes plus bas). Avec ça vous avez de quoi définir une expression Range.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Definir une Matrice (Range) en fonction du contenu de la 1ère colonne

Bonjour Gescc et bienvenu, Bernard, bonjour le forum,

J'ai considéré que les données commençaient en colonne A. Sinon tu adapteras...
Je te propose deux solutions. La première fonctionne au double-clic sur une cellule de la colonne A contenant la valeur de base de la matrice avec la macro événementielle BeforeDoubleClick à placer dans le composant VBA de l'onglet concerné (Feuil1(Feuil1) par exemple). Le code:
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim v As Integer 'déclare la variable v (Valeur)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim ma As Range 'déclare la variable ma (MAtrice)

If Target.Column <> 1 Then Exit Sub 'si le double-clic a lieu ailleurs que dans la colonne A, sort de la procédure
Cancel = True 'evite le mode édition lié au double-clic
On Error Resume Next 'gestion des erreurs, en cas d'erreur passe à la ligne suivante
v = Target.Value 'définit la valeur v
If Err <> 0 Then Exit Sub 'si une erreur a été générée, sort de la procédure
Set r = Columns(1).Find(v, , xlValues, xlWhole) 'définit la recherche r
If Not r Is Nothing Then 'condition : si la valeur éditée existe
    Set ma = Range("A1") 'initialise la plage de la matrice ma
    pa = r.Address 'définit l'adresse de la première occurrence trouvée
    Do 'exécute
        'si la plage de la matrice ma ne contient qu'une seule cellule, redéfinit la plage de la matrice ma comme la ligne de l'occurrence trouvée,
        'sinon rajoute la ligne de l'occurrence trouvé à la plage ma déjà existante
        Set ma = IIf(ma.Cells.Count = 1, r.Resize(1, 3), Application.Union(ma, r.Resize(1, 3)))
        Set r = Columns(1).FindNext(r) 'redéfinit la recherche r (occurrence suivante)
    Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
    ma.Select 'sélectionne la plage de la matrice ma (cette ligne n'est pas nécessaire et peut être effacée)
End If 'fin de la condition
End Sub

La seconde est une macro avec une boîte d'entrée (InputBox) pour renseigner la valeur de base à placer dans un module (Module1 par exemple). Le code :
Code:
Sub Macro1()
Dim be As Variant 'déclare la variable be (Boîte d'Entrée)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim ma As Range 'déclare la variable ma (Matrice)

deb: 'étiquette
be = Application.InputBox("Tapez la valeur de la matrice.", "VALEUR", Type:=1) 'définit la boîte d'entré be
If be = False Then Exit Sub 'si bouton "Annuler", sort de la procédure
Set r = Columns(1).Find(be, , xlValues, xlWhole) 'définit la recherche r
'si la valeur éditée n'existe pas, si "Oui" au message retour à la boîte d'entrée via l'étiquette "deb", si "Non" au message, sort de la procédure
If r Is Nothing Then If MsgBox("La valeur n'exite pas ! Voulez-vous recommencer ?", vbYesNo) = vbNo Then Exit Sub Else GoTo deb
Set ma = Range("A1") 'initialise la plage de la matrice ma
If Not r Is Nothing Then 'condition : si la valeur éditée existe
    pa = r.Address 'définit l'adresse de la première occurrence trouvé
    Do 'exécute
        'si la plage de la matrice ma ne contient qu'une seule cellule, redéfinit la plage de la matrice ma comme la ligne de l'occurrence trouvée,
        'sinon rajoute la ligne de l'occurrence trouvé à la plage ma déjà existante
        Set ma = IIf(ma.Cells.Count = 1, r.Resize(1, 3), Application.Union(ma, r.Resize(1, 3)))
        Set r = Columns(1).FindNext(r) 'redéfinit la recherche r (occurrence suivante
    Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
End If 'fin de la condition
ma.Select 'sélectionne la plage de la matrice ma (cette ligne n'est pas nécessaire et peut être effacée)
End Sub
 

Pièces jointes

  • Gescc_v01.xlsm
    20.8 KB · Affichages: 56

Efgé

XLDnaute Barbatruc
Re : Definir une Matrice (Range) en fonction du contenu de la 1ère colonne

Bonjour gescc, Bonjour Dranreb, Bonjour Robert

Une proposition qui laisse Excel Calculer la plage et réduit le code:
Une plage dynamique pour la liste des valeurs en colonne A
=DECALER(Feuil1!$A$2;;;NBVAL(Feuil1!$A:$A)-1; )
Un nom "Variable" qui reçoit la variable à traiter (qui est défini par la macro).
Une plage nommée qui utilise les deux premières:
=DECALER(Feuil1!$A$1;EQUIV(Variable;Liste;0);;NB.SI(Liste;Variable);3)

Au choix en cellule $E$1, lancement du code :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$1" Then
    ' si la valeur de la cellule $E$1 n'est pas valide
    On Error Resume Next
    'On donne au nom "Variable" la valeur de la variable
    'La variable peux venir du code.....
    ActiveWorkbook.Names.Add Name:="Variable", RefersToR1C1:="=" & [$E$1]
    'Selection de la plage (pour visualiser)
    [Plage].Select
    'Affichage de l'adresse de la plage (pour visualiser)
    MsgBox [Plage].Address
End If
End Sub
Cordialement
 

Pièces jointes

  • gescc(2).xlsm
    15.6 KB · Affichages: 47
Dernière édition:

gescc

XLDnaute Nouveau
Re : Definir une Matrice (Range) en fonction du contenu de la 1ère colonne

Bonjour Dranreb, Bonjour Robert, Bonjour Efgé,

Merci pour votre aide,
Il va falloir que j'adapte tout çà, dans mon cas précis la 1ère Colonne à des celulles avec du texte,
et la valeur à rechercher passe par un critère de la fonction que j'ai créé.

Code VBA :
Function RMult(valcherch As Variant, zone As Long, x As Range, colonne As Long, Rep_F As Range) As Variant
Dim u As Variant
Dim boucle As Long

For boucle = 1 To x.Rows.Count
If x(boucle, zone) Like valcherch And x(boucle, 1) = Rep_F Then
u = u & x(boucle, colonne) & "*"
End If
Next boucle
RMult = u
If RMult = 0 Then RMult = ""
If RMult <> "" Then RMult = Left(RMult, Len(RMult) - 1)
End Function


Rep_F : correspond à la vakeur de la 1ère colonne délimitant la matrice (entre autre)
X : Correspond pour l'instant à la matrice totale (ci qui alourdit le temps de calcul), que je voudrais remplacer par une matrice limité.

Cdt.
 

Dranreb

XLDnaute Barbatruc
Re : Definir une Matrice (Range) en fonction du contenu de la 1ère colonne

Bonjour.

Essayez déjà comme ça :
VB:
Function RMult(ByVal ValCherch As Variant, ByVal ColRech As Long, ByVal Plage As Range, ByVal ColResti As Long, ByVal Rep_F As Variant) As String
Dim T() As Variant, L As Long
T = Plage.Value
For L = 1 To UBound(T)
   If T(L, ColRech) Like ValCherch And T(L, 1) = Rep_F Then RMult = RMult & T(L, ColResti) & "*"
   Next L
If Len(RMult) > 0 Then RMult = Left(RMult, Len(RMult) - 1)
End Function
Dites vous bien qu'il vaux mieux n'accéder qu'une seule fois à un Range pour en récupérer un million de valeurs cellules dans un tableau que d'y accéder ne serait-ce qu'une dizaine de fois pour n'en récupérer chaque fois qu'une seule.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 810
dernier inscrit
mohammedaminelahbali