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 !
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 !