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

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Trirème
Le #4805601
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




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

Trirème
Trirème
Le #4805561
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

Rex
Le #4805291
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" #
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



Modeste
Le #4805281
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)))

rthompson
Le #4805261
Mille bornes !!!!!

Tu connais le jeu?

Rex :-)))) ))



"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)))





rthompson
Le #4657851
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" %
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



rthompson
Le #4657801
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" u$
PS : Je ne suis pas n'importe qui Môssieur

Trirème


Publicité
Poster une réponse
Anonyme