Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Souci avec List (Trirème ou n'importe qui)

Souci avec List (Trirème ou n'importe qui)

8 réponses
Avatar
rthompson
Bonjour à toutes et tous

Je dis Trirème, simplement parce que c'est lui qui m'a fournit ce code


Mais je suis ouvert à toutes propositions (honnêtes ;-))))))))


Voici un bout de code confectionné par Trirème

Dans le fichier qu'il m'a fait parvenir cela fonctionne impeccable

Mais bien sur, maintenant que je l'ai transféré vers mon fichier j'ai des
soucis


Je suis resté bloqué sur plusieurs lignes, mais je m'en suis sorti

Celle qui me bloque depuis un bon de temps maintenant est celle-ci

LaListe = Left(LaListe, Len(LaListe) - 1)

Just après le End With

J'ai adapté les noms et les Range et cellules etc

J'ai même essayé de remplacer LEN par NBCHAR sans succès

Si quelqu'un a une idée


D'avance merci beaucoup

A bientôt

Rex

Voici le code transformé et en fin de message le code original


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$3" Then
[J4].ClearContents
' *********** initialisations **************************
Datas = "Datas" ' Nom de la plage de données
Offre = "Offers" ' Nom de l'onglet contenant les Datas
Consultation = "Tracking_Orders"
OffreNom = "Offre-Nom" ' Nom de l'entête de colonne des Offres-Nom
Statut = "Status" ' Nom de l'entête de colonne des Statuts
' ************ fin d'initialisation *********************
LaListe = ""
' Construire une liste de validation à partir des 'Offre-Nom' qui
conviennent
With Worksheets(Offre)
NumeroColonneOffreNom = Application.Match(OffreNom,
.Range(Datas).Resize(1), 0)
' En recherchant la position de la colonne dans la 1ère ligne des
Datas,
' On évite les erreurs en cas de déplacement ou ajout de colonnes.
NumeroColonneStatus = Application.Match(Statut,
.Range(Datas).Resize(1), 0)
Decalage = NumeroColonneStatus - NumeroColonneOffreNom
For Each c In .Range(Datas).Offset(1, NumeroColonneOffreNom -
1).Resize(, 1)
' La colonne contenant 'Offre-Nom' est cherchée automatiquement
If c.Offset(, Decalage) = [J3] Then
LaListe = LaListe & c & ","
End If
Next
End With
LaListe = Left(LaListe, Len(LaListe) - 1)
' On supprime la dernière virgule qui est en trop
With Worksheets(Tracking_Orders).[J4].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=
_
xlBetween, Formula1:=LaListe
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Et l'original

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$4" Then
[I6].ClearContents
' *********** initialisations **************************
Datas = "Datas" ' Nom de la plage de données
Offre = "Offres" ' Nom de l'onglet contenant les Datas
Consultation = "Consultation"
OffreNom = "Offre-Nom" ' Nom de l'entête de colonne des Offres-Nom
Statut = "Status" ' Nom de l'entête de colonne des Statuts
' ************ fin d'initialisation *********************
LaListe = ""
' Construire une liste de validation à partir des 'Offre-Nom' qui
conviennent
With Worksheets(Offre)
NumeroColonneOffreNom = Application.Match(OffreNom,
.Range(Datas).Resize(1), 0) ' En recherchant la position de la colonne dans
la 1ère ligne des Datas,

' On évite les erreurs en cas de déplacement ou ajout de
colonnes.
NumeroColonneStatus = Application.Match(Statut,
.Range(Datas).Resize(1), 0)
Decalage = NumeroColonneStatus - NumeroColonneOffreNom
For Each c In .Range(Datas).Offset(1, NumeroColonneOffreNom -
1).Resize(, 1) ' La colonne contenant 'Offre-Nom' est cherchée
automatiquement
If c.Offset(, Decalage) = [I4] Then
LaListe = LaListe & c & ","
End If
Next
End With
LaListe = Left(LaListe, Len(LaListe) - 1) ' On supprime la dernière
virgule qui est en trop
With Worksheets(Consultation).[I6].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=
_
xlBetween, Formula1:=LaListe
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Trirème
Bonjour Rex,
Quand tu parles de blocage, il s'agit bien d'un blocage de l'exécution du code, pas un
blocage de la compréhension de l'instruction ?
Ça doit certainement être la 1ère hypothèse... ;-)

Donc, l'anomalie est curieuse car la formule utilise des fonctions VBA (insensibles à la
langue de l'utilisateur).
Quelle est la valeur de 'LaListe' au moment du blocage ? Pour le savoir, affiche la dans
la fenêtre espion ou par un MsgBox LaListe.
Si ça bloque c'est surement que la liste est vide (choix d'un item de la liste de
validation qui est absent de ta table de données !!!).
Dans ce cas remplace la ligne :

LaListe = Left(LaListe, Len(LaListe) - 1)

par les 2 lignes :

If LaListe = "" Then Exit Sub
LaListe = Left(LaListe, Len(LaListe) - 1)

Cordialement,
Trirème

Bonjour à toutes et tous

Je dis Trirème, simplement parce que c'est lui qui m'a fournit ce code


Mais je suis ouvert à toutes propositions (honnêtes ;-))))))))


Voici un bout de code confectionné par Trirème

Dans le fichier qu'il m'a fait parvenir cela fonctionne impeccable

Mais bien sur, maintenant que je l'ai transféré vers mon fichier j'ai des
soucis


Je suis resté bloqué sur plusieurs lignes, mais je m'en suis sorti

Celle qui me bloque depuis un bon de temps maintenant est celle-ci

LaListe = Left(LaListe, Len(LaListe) - 1)

Just après le End With

J'ai adapté les noms et les Range et cellules etc

J'ai même essayé de remplacer LEN par NBCHAR sans succès

Si quelqu'un a une idée


D'avance merci beaucoup

A bientôt

Rex

Voici le code transformé et en fin de message le code original


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$3" Then
[J4].ClearContents
' *********** initialisations **************************
Datas = "Datas" ' Nom de la plage de données
Offre = "Offers" ' Nom de l'onglet contenant les Datas
Consultation = "Tracking_Orders"
OffreNom = "Offre-Nom" ' Nom de l'entête de colonne des Offres-Nom
Statut = "Status" ' Nom de l'entête de colonne des Statuts
' ************ fin d'initialisation *********************
LaListe = ""
' Construire une liste de validation à partir des 'Offre-Nom' qui
conviennent
With Worksheets(Offre)
NumeroColonneOffreNom = Application.Match(OffreNom,
.Range(Datas).Resize(1), 0)
' En recherchant la position de la colonne dans la 1ère ligne des
Datas,
' On évite les erreurs en cas de déplacement ou ajout de colonnes.
NumeroColonneStatus = Application.Match(Statut,
.Range(Datas).Resize(1), 0)
Decalage = NumeroColonneStatus - NumeroColonneOffreNom
For Each c In .Range(Datas).Offset(1, NumeroColonneOffreNom -
1).Resize(, 1)
' La colonne contenant 'Offre-Nom' est cherchée automatiquement
If c.Offset(, Decalage) = [J3] Then
LaListe = LaListe & c & ","
End If
Next
End With
LaListe = Left(LaListe, Len(LaListe) - 1)
' On supprime la dernière virgule qui est en trop
With Worksheets(Tracking_Orders).[J4].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=
_
xlBetween, Formula1:=LaListe
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Et l'original

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$4" Then
[I6].ClearContents
' *********** initialisations **************************
Datas = "Datas" ' Nom de la plage de données
Offre = "Offres" ' Nom de l'onglet contenant les Datas
Consultation = "Consultation"
OffreNom = "Offre-Nom" ' Nom de l'entête de colonne des Offres-Nom
Statut = "Status" ' Nom de l'entête de colonne des Statuts
' ************ fin d'initialisation *********************
LaListe = ""
' Construire une liste de validation à partir des 'Offre-Nom' qui
conviennent
With Worksheets(Offre)
NumeroColonneOffreNom = Application.Match(OffreNom,
.Range(Datas).Resize(1), 0) ' En recherchant la position de la colonne dans
la 1ère ligne des Datas,

' On évite les erreurs en cas de déplacement ou ajout de
colonnes.
NumeroColonneStatus = Application.Match(Statut,
.Range(Datas).Resize(1), 0)
Decalage = NumeroColonneStatus - NumeroColonneOffreNom
For Each c In .Range(Datas).Offset(1, NumeroColonneOffreNom -
1).Resize(, 1) ' La colonne contenant 'Offre-Nom' est cherchée
automatiquement
If c.Offset(, Decalage) = [I4] Then
LaListe = LaListe & c & ","
End If
Next
End With
LaListe = Left(LaListe, Len(LaListe) - 1) ' On supprime la dernière
virgule qui est en trop
With Worksheets(Consultation).[I6].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=
_
xlBetween, Formula1:=LaListe
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub




Avatar
Trirème
PS : Je ne suis pas n'importe qui Môssieur

Trirème
Avatar
Trirème
Dans ce cas remplace la ligne :

LaListe = Left(LaListe, Len(LaListe) - 1)

par les 2 lignes :

If LaListe = "" Then Exit Sub
LaListe = Left(LaListe, Len(LaListe) - 1)

ou mieux effectue ces 3 modifications...


1) remplacer :
LaListe = ""
par :
LaListe = "": compt = 0

2) remplacer :
LaListe = LaListe & c & ","
par :
LaListe = LaListe & c & ",": compt = compt + 1

3) remplacer :
LaListe = Left(LaListe, Len(LaListe) - 1)

par :
If LaListe = "" Then
[J3] = "Aucune correspondance"
Exit Sub
Else
LaListe = Left(LaListe, Len(LaListe) - 1)
[J3] = compt & " correspondance(s)"
End If
Si la cellule J3 est nommée 'Offre_Nom' change aussi
[J3]= par Range("Offre_Nom") ci-dessus

Cordialement,
Trirème

Avatar
Rex
Bonsoir

Je suis de retour depuis peu de temps

Mais comme il est très tard je vais y regarder demain matin à tête reposée


A demain et bonne nuit

Et surtout merci

Rex :-zzzzzzzzzz
Je ne sais pas si comme ça qu'on dit que je suis crevé


"Trirème" a écrit dans le message de news:
#
Dans ce cas remplace la ligne :

LaListe = Left(LaListe, Len(LaListe) - 1)

par les 2 lignes :

If LaListe = "" Then Exit Sub
LaListe = Left(LaListe, Len(LaListe) - 1)

ou mieux effectue ces 3 modifications...


1) remplacer :
LaListe = ""
par :
LaListe = "": compt = 0

2) remplacer :
LaListe = LaListe & c & ","
par :
LaListe = LaListe & c & ",": compt = compt + 1

3) remplacer :
LaListe = Left(LaListe, Len(LaListe) - 1)

par :
If LaListe = "" Then
[J3] = "Aucune correspondance"
Exit Sub
Else
LaListe = Left(LaListe, Len(LaListe) - 1)
[J3] = compt & " correspondance(s)"
End If
Si la cellule J3 est nommée 'Offre_Nom' change aussi
[J3]= par Range("Offre_Nom") ci-dessus

Cordialement,
Trirème



Avatar
Modeste
Bonsour® Rex avec ferveur ;o))) vous nous disiez :

Rex :-zzzzzzzzzz
Je ne sais pas si comme ça qu'on dit que je suis crevé
en quelque sorte : a flat T.Rex

;o)))
http://cjoint.com/?ioayWXducd
mais AV dit simplement : pfffftttt....

--
@+
;o)))

Avatar
rthompson
Mille bornes !!!!!

Tu connais le jeu?

Rex :-)))) ))



"Modeste" a écrit dans le message de news:

Bonsour® Rex avec ferveur ;o))) vous nous disiez :

Rex :-zzzzzzzzzz
Je ne sais pas si comme ça qu'on dit que je suis crevé
en quelque sorte : a flat T.Rex

;o)))
http://cjoint.com/?ioayWXducd
mais AV dit simplement : pfffftttt....

--
@+
;o)))





Avatar
rthompson
Bonjour

MERCI

On avance encore de quelques lignes

Mais cela ne tourne toujours pas

Maintenant sur la ligne

With Worksheets(Tracking_Orders).[J4].Validation

Il me mets le message

Erreur no.

Out of Stack Space


Cela te dis quelque chose?


Comme tu n'es peut-être pas là, et que je voudrais avancer, je vais lancer
un nouveau fil

Mais je continue à suivre celui-ci

A bientôt

Rex



"Trirème" a écrit dans le message de news:
%
Dans ce cas remplace la ligne :

LaListe = Left(LaListe, Len(LaListe) - 1)

par les 2 lignes :

If LaListe = "" Then Exit Sub
LaListe = Left(LaListe, Len(LaListe) - 1)

ou mieux effectue ces 3 modifications...


1) remplacer :
LaListe = ""
par :
LaListe = "": compt = 0

2) remplacer :
LaListe = LaListe & c & ","
par :
LaListe = LaListe & c & ",": compt = compt + 1

3) remplacer :
LaListe = Left(LaListe, Len(LaListe) - 1)

par :
If LaListe = "" Then
[J3] = "Aucune correspondance"
Exit Sub
Else
LaListe = Left(LaListe, Len(LaListe) - 1)
[J3] = compt & " correspondance(s)"
End If
Si la cellule J3 est nommée 'Offre_Nom' change aussi
[J3]= par Range("Offre_Nom") ci-dessus

Cordialement,
Trirème



Avatar
rthompson
Oh que non tu n'es pas n'importe qui Môsieur

Tu es Môôôôsieur de N'importe qui

Avessse un petit "d" et un "N" majessscule

Rex ;-))))

PS Petit "d" particule d'une personnalité d'une cerrtaine noblesse

Plus il ya de petit "d" plus la noblesse est officiel ou ancienne je ne sais
plus

Comme par exemple Pomme de terre de mon jardin


"Trirème" a écrit dans le message de news:
u$
PS : Je ne suis pas n'importe qui Môssieur

Trirème