Recherche Valeur d'après liste

  • Initiateur de la discussion Selmer78
  • Date de début
S

Selmer78

Guest
Bonjour à tous,

J'ai mis au point une petite macro qui me permet de rechercher une valeur dans toutes les cellules d'une colonne d'après une liste prédéfinie (voir macro ci-dessous).
Mon problème vient du fait qu'il est possible d'avoir un champ concatené dans la cellule à tester et je ne trouve pas la bonne syntaxe pour contrôler la présence de la valeur rechercher.

Code :

NomFichierCtrl = 'num_serie_vol.txt'
Workbooks.Open Filename:=ActiveWorkbook.Path & '\\' & NomFichierCtrl

Columns('A:A').Select
Selection.TextToColumns Destination:=Range('A1'), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1))

Cells.Copy
'Windows(2).Activate
Workbooks(FichierXls).Activate

Sheets('Ctrl').Select
ActiveSheet.Paste
Range('A1').Select
Application.CutCopyMode = False

' fermer fichier txt
Windows(2).Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True

' derniereLigne
DerniereLigneCtrl = Sheets('Ctrl').Range('A1').CurrentRegion.Rows.Count + 1

' derniereColonne
DerniereColonneCtrl = Sheets('Ctrl').Range('A1').CurrentRegion.Columns.Count

' zone de donnees
ZoneDonneesCtrl = 'Ctrl!A1:' + Cells(DerniereLigne, DerniereColonne).Address

NumLigne = 1
MessageCtrl = 'Aucun'
For NumLigneCtrl = 2 To DerniereLigneCtrl
' recherche de la ligne avec le N° série
While (Sheets('tbl').Cells(NumLigne, 29) > Cells(DerniereLigne, 29))
If (Sheets('tbl').Cells(NumLigne, 29) Like Sheets('ctrl').Cells(NumLigneCtrl, 1)) Then
If (Sheets('ctrl').Cells(NumLigneCtrl, 1) Like Sheets('tbl').Cells(NumLigne, 29)) Then
' Coloriage en rouge de la ligne avec le N° serie en erreur
Sheets('tbl').Select
For NumLigneColoriage = 1 To DerniereColonne
Cells(NumLigne, NumLigneColoriage).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Next NumLigneColoriage

If MessageCtrl <> 'Aucun' Then
MessageCtrl = MessageCtrl + ', ' + ValeurCtrl
Else
MessageCtrl = Sheets('ctrl').Cells(NumLigneCtrl, 1).Value
End If
Else
End If
NumLigne = NumLigne + 1
Wend
NumLigne = 1
Next NumLigneCtrl

Voilà, je reste à votre disposition pour tout complément d'information. Merci d'avance !
 

Selmer78

XLDnaute Nouveau
Rebonjour,

En fait au lieu d'avoir une cellule avec une valeur du genre 925634 ou p25974, il peut y avoir ce genre : 924582,96745,p2559
Et ce que je n'arrive pas à faire, c'est de trouver dans une cellule comportant plusieurs valeur la correspondance avec mon une valeur de mon fichier référence.
Encore merci !
 

Bebere

XLDnaute Barbatruc
bonjour à tous deux
emploi caractères joker *(pluieurs caractères) ou ?(1 caractère)
exemple : '*96745*'

dans les lignes(comme çi-dessous) avec + je mettrais & à la place du +
ZoneDonneesCtrl = 'Ctrl!A1:' + Cells(DerniereLigne, DerniereColonne).Address
au revoir
 

Hellboy

XLDnaute Accro
re

Selmer78 écrit:
Rebonjour,

En fait au lieu d'avoir une cellule avec une valeur du genre 925634 ou p25974, il peut y avoir ce genre : 924582,96745,p2559
Et ce que je n'arrive pas à faire, c'est de trouver dans une cellule comportant plusieurs valeur la correspondance avec mon une valeur de mon fichier référence.
Encore merci !

avec la commande split tu pourrais arriver a tes fins.
exemple:
Code:
Cellule = Split(Cells(1, 1), ',')

Commentaires: La commande Split subdivise une chaine de caractères selon un critère. Dans cet exemple une virgule. Dans le cas de ton exemple(924582,96745,p2559) il te retoure Cellule avec 3 item. Tu n'as qu'a boucler dessus. Même si tu n'as pas de virgule ds la cellule, pas de problême non plus.

Message édité par: Hellboy, à: 29/06/2005 18:32
 

Selmer78

XLDnaute Nouveau
Bonjour à tous,

Merci pour vos conseil, faute de temps je n'ai pas pu essayer la fonction Split, mais j'ai réussi à trouver la syntaxe pour contrôler la présence d'une valeur lamba :
Ancienne ligne macro : If (Sheets('tbl').Cells(NumLigne, 29) Like Sheets('ctrl').Cells(NumLigneCtrl, 1)) Then
Nouvelle ligne macro : If (Sheets('tbl').Cells(NumLigne, 29) Like '*' & Sheets('ctrl').Cells(NumLigneCtrl, 1) & '*') Then
J'ai en fait rajouté '*' & avant et & '*' après ma variable et cela fonctionne bien. C'est Bebere qui ma mis sur la voie en me disant de mettre & à la place de mon + sur une autre ligne.
Encore merci à tous les 2.
A+

;)
 

Discussions similaires

Statistiques des forums

Discussions
312 291
Messages
2 086 844
Membres
103 400
dernier inscrit
MINOU WILL